作者:乔山办公网日期:
返回目录: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运行代码,结果如下: