如何将一个Excel列中的值替换为同一行中可变数量的列连接的值？

Question

我尝试转换导出的Excel报表的输出，该报表包含许多行，每行包含可变数量的包含数据的列。导出无法修改。这是我必须要做的事情。

A栏可能包含也可能不包含文字。 B列包含与此问题无关的数据（除了它的方式，并且必须对其进行编码）。列C，D和以后可能包含也可能不包含文本，但这些文本填充是一致的，从左到右顺序排列，即文本永远不会跳过＆＃34;跳过＆＃34;列 - 如果列E是包含文本的行中的最后一列，则列D和C也将包含文本。

我的目标是将所有这些单独的文本值连接到每行的Column A单元格中（由Vertical Line字符分隔），然后仅在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  

（我知道这些并不是很好的表示，但我无法嵌入图片。这里有'Before' pic和'After' pic的Excel表格。

现在这就是我迄今编码的内容。它只设置为连接A列和C列。我觉得我在正确的轨道上设置范围并使文本字符串之间的垂直线格式正确，但我需要能够处理每行的可变列范围 - 用于在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

在：

在