根据第一列合并多行

Question

我有一个excel，包含两个列(B & C) --业务用例和解决方案，将有多个业务用例可能有相同的解决方案，我想基于解决方案合并它。就像下面这样-

BC1 Sol1
BC2 Sol2
BC3 Sol2
BC4 Sol3
BC5 Sol4
BC6 Sol4
BC7 Sol4

产出应是-

BC1 Sol1
BC2, BC3 Sol2
BC4 Sol3
BC5, BC6, BC7 Sol4

我想在VBA上做这件事，并尝试了如下所示-

LASTROW = Range("C" & Rows.Count).End(xlUp).Row 'get last row
For I = 0 To LASTROW Step 1
    For J = I + 1 To LASTROW Step 1
        If Cells(I, "C") = Cells(J, "C") Then
            Cells(I, "B") = Cells(I, "B") & "," & Cells(J, "B")
            Rows(J).Delete
        End If
    Next
Next

上面的工作，但是非常缓慢的运行在1000行，我经历了其他类似的问题，但在VBA不太好的模式以上一个。有人能帮忙吗？

Answer 1

正如您所评论的，使用变体数组而不是直接循环单元格将极大地加快速度。

要在这里应用这一点，您可以：

1. 确定源数据范围，并将其复制到数组中。
2. 创建另一个数组以包含新数据
3. 循环源数组，测试所需的模式，并填充目标数组
4. 将新数据复制回工作表，覆盖旧数据。

Sub Demo()
    Dim ws As Worksheet
    Dim rng As Range
    Dim datSrc As Variant
    Dim datDst As Variant
    Dim i As Long
    Dim j As Long
    Dim rwOut As Long
    Dim str As String

    Set ws = ActiveSheet

    With ws
        Set rng = Range(.Cells(1, 2), .Cells(.Rows.Count, 3).End(xlUp))
        datSrc = rng.Value

        ReDim datDst(1 To UBound(datSrc, 1), 1 To UBound(datSrc, 2))
        rwOut = 1

        For i = 1 To UBound(datSrc, 1)
            str = datSrc(i, 1)
            If datSrc(i, 2) <> vbNullString Then
                For j = i + 1 To UBound(datSrc, 1)
                    If datSrc(i, 2) = datSrc(j, 2) Then
                        str = str & "," & datSrc(j, 1)
                        datSrc(j, 2) = vbNullString
                    End If
                Next
                datDst(rwOut, 1) = str
                datDst(rwOut, 2) = datSrc(i, 2)
                rwOut = rwOut + 1
            End If
        Next
        rng = datDst
    End With
End Sub