如何用同一行中可變數量的列連接的值替換一個Excel列中的值？

Question

我正在嘗試轉換包含許多行的導出的Excel報表的輸出，每行具有可變數量的包含數據的列。 導出無法修改。 這是我必須處理的。

A列可能包含也可能不包含文本。 B列包含與此問題不相關的數據（除了它的方式，必須對其進行編碼）。 C，D列及后續列可能包含也可能不包含文本，但是這些文本填充是一致的，並且是從左到右順序排列的，即，文本永遠不會“跳過”列-如果E列是包含文本的行中的最后一列，則Columns D和C也將包含文本。

我的目標是將所有這些單獨的文本值連接到每行的“列A”單元格中（由“垂直線”字符分隔），然后僅在列A和B中保留值。

因此，如果導出看起來像：

      ColA   ColB   ColC   ColD

Row1  Alpha  xxxxx
Row2
Row3  Gamma  xxxxx  Theta
Row4
Row5  Delta  xxxxx  Kappa  Sigma

轉換后的輸出應類似於：

      ColA                   ColB   ColC   ColD

Row1  Alpha                  xxxxx
Row2
Row3  Gamma | Theta          xxxxx  
Row4
Row5  Delta | Kappa | Sigma  xxxxx  

（我知道這些不是很好的表示形式，但是我不能嵌入圖像。這是Excel工作表的“之前”圖片和“之后”圖片 ）

現在，這就是到目前為止我編寫的代碼。 它僅設置為連接A和C列。我覺得我在設置范圍和使文本字符串之間的Vertical Line格式正確方面走在正確的道路上，但我需要能夠處理每個列的可變列范圍row —用於在例程完成后在A列中創建串聯的文本字符串，並向前刪除C列中的值。

Sub ColumnConcat()

Dim firstComment As Range
Set firstComment = Range("A1")

Dim lastComment As Range
Set lastComment = Range("B1").End(xlDown).Offset(0, -1)

Dim commentRange As Range
Set commentRange = Range(firstComment, lastComment)

Dim commentCell As Range

For Each commentCell In commentRange

  If IsEmpty(commentCell.Offset(0, 2).Value) = True Then
    commentCell.Value = commentCell

      Else

    Dim firstConcatComment As Range
    Set firstConcatComment = commentCell.Offset(0, 2)

    commentCell.Value = commentCell & " | " & firstConcatComment

  End If

Next commentCell

Range("C1:E1").EntireColumn.Delete Shift:=xlToLeft

End Sub

Answer 1

對於這樣的事情，我更喜歡將整體加載到數組中，然后遍歷該數組並加載第二個數組。

它比遍歷范圍更快，因為它僅兩次而不是多次引用工作表上的數據。

Sub ColumnConcat()
Dim ws As Worksheet
Set ws = Worksheets("Sheet28") 'Change to your sheet name or ActiveSheet.


Dim rngArr() As Variant
Dim OArr() As Variant
rngArr = ws.UsedRange
ReDim OArr(LBound(rngArr, 1) To UBound(rngArr, 1), 1 To 2) As Variant

For i = LBound(rngArr, 1) To UBound(rngArr, 1)
    OArr(i, 1) = rngArr(i, 1) & " | "
    OArr(i, 2) = rngArr(i, 2)
    For j = 3 To UBound(rngArr, 2)
        If rngArr(i, j) = "" Then Exit For
        OArr(i, 1) = OArr(i, 1) & rngArr(i, j) & " | "
    Next j
    If OArr(i, 1) <> "" Then
        OArr(i, 1) = Left(OArr(i, 1), Len(OArr(i, 1)) - 3)
    End If
Next i

ws.UsedRange.Clear
ws.Range("A1").Resize(UBound(OArr, 1), UBound(OArr, 2)).Value = OArr
End Sub

之前：

后