计算单元格中文本的行数

我有一个Excel电子表格数据工作，我需要在VBA分裂。 有几列有多行文字，有些则没有。 我已经想出了如何分割多行文本，我的问题是使用一行文本并复制它的列。 例如：

Company_Name Drug_1 Phase_2 USA Drug_2 Discontinued Drug_3 Phase_1 Europe Drug_4 Discontinued 

下面是我用来拆分B＆C列的代码，然后我可以手动处理D，但是我需要列A复制到第2-4行。 有超过600个这样的行，否则我只是手动做。 （注：我把B列放到A下面，C列放到C中）

 Sub Splitter() Dim iPtr1 As Integer Dim iPtr2 As Integer Dim iBreak As Integer Dim myVar As Integer Dim strTemp As String Dim iRow As Integer 'column A loop iRow = 0 For iPtr1 = 1 To Cells(Rows.Count, 1).End(xlUp).Row strTemp = Cells(iPtr1, 1) iBreak = InStr(strTemp, vbLf) Range("C1").Value = iBreak Do Until iBreak = 0 If Len(Trim(Left(strTemp, iBreak - 1))) > 0 Then iRow = iRow + 1 Cells(iRow, 2) = Left(strTemp, iBreak - 1) End If strTemp = Mid(strTemp, iBreak + 1) iBreak = InStr(strTemp, vbLf) Loop If Len(Trim(strTemp)) > 0 Then iRow = iRow + 1 Cells(iRow, 2) = strTemp End If Next iPtr1 'column C loop iRow = 0 For iPtr2 = 1 To Cells(Rows.Count, 3).End(xlUp).Row strTemp = Cells(iPtr2, 3) iBreak = InStr(strTemp, vbLf) Do Until iBreak = 0 If Len(Trim(Left(strTemp, iBreak - 1))) > 0 Then iRow = iRow + 1 Cells(iRow, 4) = Left(strTemp, iBreak - 1) End If strTemp = Mid(strTemp, iBreak + 1) iBreak = InStr(strTemp, vbLf) Loop If Len(Trim(strTemp)) > 0 Then iRow = iRow + 1 Cells(iRow, 4) = strTemp End If Next iPtr2 End Sub 

Answer 1

有一些我称之为“瀑布填充”的代码就是这样做的。 如果你可以build立一个单元格来填充（即设置rng_in ），它会做到这一点。 它适用于任何数量的列，这是一个很好的function。 你可以诚实地给它一个A:D的范围，它会抛光你的空白。

 Sub FillValueDown() Dim rng_in As Range Set rng_in = Range("B:B") On Error Resume Next Dim rng_cell As Range For Each rng_cell In rng_in.SpecialCells(xlCellTypeBlanks) rng_cell = rng_cell.End(xlUp) Next rng_cell On Error GoTo 0 End Sub 

之前和之后 ，显示代码填写。

怎么运行的

此代码通过获取所有空白单元格的范围。 默认情况下， SpecialCells只会查看UsedRange因为xlCellTypeBlanks有一个怪癖 。 从那里它使用End(xlUp)将空白单元格的值设置为等于最靠近的单元格的值。 error handling就绪，因为如果找不到任何东西， xlCellTypeBlanks将返回一个错误。 如果你用顶部的空白行做整列（如图），这个错误永远不会被触发。