excel - 如何使用 VBA 连接多个列

Question

假设我有这张桌子：

我想看看：

这个问题的后续行动：

为了添加更多列，我一生都无法理解此代码。该代码适用于“名称、类型、食物”，但我需要添加“地点”和“日期”。

Sub Test()

Dim lr As Long, x As Long
Dim arr As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Feuil1

    'Get last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get array
    arr = .Range("A2:C" & lr).Value

    'Loop through array
    For x = LBound(arr) To UBound(arr)
        If dict.Exists(arr(x, 1) & "|" & arr(x, 2)) Then
            dict(arr(x, 1) & "|" & arr(x, 2)) = Join(Array(dict(arr(x, 1) & "|" & arr(x, 2)), arr(x, 3)), ", ")
        Else
            dict(arr(x, 1) & "|" & arr(x, 2)) = arr(x, 3)
        End If
    Next x

    'Loop through dictionary
    For x = 0 To dict.Count - 1
        .Cells(x + 2, 8).Resize(, 2).Value = Split(dict.keys()(x), "|")
        .Cells(x + 2, 10).Value = dict.items()(x)
    Next x

End With

End Sub

标签： excelvba

Answer 1

一些相对的“简单”调整将使这项工作：

Sub Test()

Dim lr As Long, x As Long
Dim arr As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1

    'Get last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get array
    arr = .Range("A2:E" & lr).Value

    'Loop through array
    For x = LBound(arr) To UBound(arr)
        If dict.Exists(arr(x, 1) & "|" & arr(x, 2) & "$" & arr(x, 4) & "|" & arr(x, 5)) Then
            dict(arr(x, 1) & "|" & arr(x, 2) & "$" & arr(x, 4) & "|" & arr(x, 5)) = Join(Array(dict(arr(x, 1) & "|" & arr(x, 2) & "$" & arr(x, 4) & "|" & arr(x, 5)), arr(x, 3)), ", ")
        Else
            dict(arr(x, 1) & "|" & arr(x, 2) & "$" & arr(x, 4) & "|" & arr(x, 5)) = arr(x, 3)
        End If
    Next x

    'Loop through dictionary
    For x = 0 To dict.Count - 1
        .Cells(x + 2, 6).Resize(, 2).Value = Split(Split(dict.keys()(x), "$")(0), "|")
        .Cells(x + 2, 8).Value = dict.items()(x)
        .Cells(x + 2, 9).Resize(, 2).Value = Split(Split(dict.keys()(x), "$")(1), "|")
    Next x

End With

End Sub

希望你能理解。对于您最初问题中不幸的措辞，一切都很好。不用担心。

快乐编码