Question

我有一个excel有两列（B＆amp; 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

正如您所评论的那样，使用变体数组而不是直接循环单元格会极大地提高速度

要在此处申请，您可以：

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

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

根据第一列合并多行

1 个答案: