計算單元格中的文本行數

Question

我有一份Excel電子表格數據，用於我需要在VBA中分離的工作。有幾列有多行文字，其他則沒有。我已經想出瞭如何分割多行文本，我的問題是使用單行文本並將其複製下來。例如：

Company_Name  Drug_1  Phase_2  USA 
       Drug_2  Discontinued 
       Drug_3  Phase_1  Europe 
       Drug_4  Discontinued 

下面是我使用分裂乙& C柱的代碼，然後我可以處理ð手動，但是我需要塔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

有一些代碼我稱之爲「瀑布補」，這正是這一點。如果你可以建立一系列的單元格來填充（例如設置rng_in），它就可以完成。它適用於任何數量的列，這是一個很好的功能。你可以誠實地餵它一系列的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由於quirk with xlCellTypeBlanks只能查看UsedRange。從那裏它使用End(xlUp)將空白單元的值設置爲等於最靠近單元的頂部單元。如果沒有找到，xlCellTypeBlanks將返回錯誤，因此錯誤處理已到位。如果你用頂部的空白行做整列（如圖片），那麼錯誤永遠不會被觸發。