乔山办公网我们一直在努力
您的位置:乔山办公网 > excel表格制作 > 请问如何用<em>vba</em>获取<em>excel</em>某一单

请问如何用<em>vba</em>获取<em>excel</em>某一单

作者:乔山办公网日期:

返回目录:excel表格制作


选中目标单元格,执行下面的过程即可7a686964616fe59b9ee7ad94336

Option Explicit
Sub GetMultiLine()
Dim OStr As String, OLen As Integer
OStr = ActiveCell.Value
OLen = Len(OStr)
If OLen = 0 Then
    MsgBox "空单元格"
    Exit Sub
End If
'单元格非空时获取换行符,并获取单元格内各行文本
Dim arrStr() As String, CvtASC As Long, i As Integer
Dim arrLineLoc() As Integer
Dim arrNewStr() As String, j As Integer
For i = 1 To OLen
    ReDim Preserve arrStr(1 To i)
    arrStr(i) = Mid(OStr, i, 1)
    CvtASC = Asc(arrStr(i))
    If CvtASC = 10 Then
        j = j + 1
        ReDim Preserve arrLineLoc(1 To j)
        arrLineLoc(j) = i
    End If
Next
j = j + 1
ReDim Preserve arrLineLoc(1 To j)
arrLineLoc(j) = OLen + 1
For i = 1 To j
    ReDim Preserve arrNewStr(1 To i)
    If i = 1 Then
        arrNewStr(i) = Mid(OStr, 1, arrLineLoc(i) - i)
    Else
        arrNewStr(i) = Mid(OStr, arrLineLoc(i - 1) + 1, arrLineLoc(i) - arrLineLoc(i - 1) - 1)
    End If
Next
'输出结果
Dim NoOfLine As Integer, OutStr As String
NoOfLine = UBound(arrNewStr)
For i = 1 To NoOfLine
    OutStr = OutStr & arrNewStr(i) & vbCr
Next
OutStr = "单元格内共有 " & NoOfLine & "行" & vbCr & OutStr
MsgBox OutStr

End Sub


Function lines(r)  'r 为某单元格,如A1
r.WrapText = False
x = r.Height
r.WrapText = True
y = r.Height
lines = y / x
End Function
使用方法 lines(range("A1"))
思路:设置该单元格不自动换行,得到此时高度x,恢复自动换行,得到此时的高度y,行数=y/x

不用vba可以吗?将单元格内容复制到记事本中,然后再粘贴回excel中就可以了

步骤如下:

1.将A1按换行符分开到B之后的列中:

2.alt+F11,输入如下代码:

3.F5运行代码,结果如下:

相关阅读

关键词不能为空
极力推荐

ppt怎么做_excel表格制作_office365_word文档_365办公网