如何在 VBA 中的相同值旁边输出相同类型的值？

Question

我想使用 VBA 获取 A 和 B 列的值，并将它们输出到 C 和 D 列，如下所示。

A列中相同的名字合二为一输出到C列
B 列中的相同值保留为一个并在 D 列中并排输出。

A	B	C	D
Suzuki	123	Suzuki	123, 456
Suzuki	456	Kato	789
Suzuki	456	SAto	100
Kato	789
Kato	789
SAto	100

我可以通过在互联网上进行研究来获得相同的价值。但是，我无法并排输出 B 列中的值。

这是我自己编写的代码，用于将相同的值合并为一个。如果您可以修改我的代码或者您有更好的代码编写方法，请告诉我。

VBA

Sub sample()

    Dim Dic, i As Integer, name As String
    Dim order_number As Long
    Set Dic = CreateObject("Scripting.Dictionary") 'Key(キー)とItem(データ)をセットで格納して、リストなどを作成するときに使用。Pythonでいうところのたぶん辞書型

    On Error Resume Next
        
        For i = 1 To 10
        
            name = Cells(i, 1).Value '荷受人の列の名前を1つずつ取得
            order_number = Cells(i, 2).Value '注文番号を1つずつ取得
            
            Dic.Add name, order_number ' Dicに追加していく

        Next i
      
        ' 出力
        For i = 0 To Dic.Count - 1
            mykeys = Dic.Keys
            myItems = Dic.Items
            Range("C" & i + 1).Value = mykeys(i)
            Range("D" & i + 1).Value = myItems(i)
        
            'オブジェクトを開放する
            Set Dic = Nothing

        Next i

End Sub

↓ 我的代码输出

A	B	C	D
Suzuki	123	Suzuki	123
Suzuki	456	Kato	789
Suzuki	456	Sato	100
Kato	789
Kato	789
Sato	100

Answer 1

您只能在字典上调用 Add - 您需要检查字典是否已经将 name 作为键，以及 Add 新键或更新现有值。

试试这个：

Sub sample()
    Dim dic As Object, i As Long, name As String, ws As Worksheet
    Dim order_number As Long
    
    Set dic = CreateObject("Scripting.Dictionary")
    Set ws = ActiveSheet
    'loop all rows of data
    For i = 1 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        name = Cells(i, 1).Value
        order_number = Cells(i, 2).Value
        If Not dic.exists(name) Then                       'new key?
            dic.Add name, order_number                     'add key and first value
        Else
            dic(name) = dic(name) & "," & order_number     'concatenate new value
        End If
    Next i
    
    DictToRange dic, ws.Range("D1")
    
    'no need to set locally-declared onjects to Nothing...
End Sub

'write keys and values from Dictionary `dic`, starting at `StartCell`
Sub DictToRange(dic As Object, StartCell As Range)
    Dim k, i
    i = 0
    For Each k In dic
        StartCell.Offset(i).Resize(1, 2).Value = Array(k, dic(k))
        i = i + 1
    Next k
End Sub

Answer 2

Sub sample()
Dim Dic, Dic2, i As Integer, name As String
Dim order_number As Long
Dim tmp_var As Variant
Dim tmp_sp() As String


Set Dic = CreateObject("Scripting.Dictionary") 'Key(キー)とItem(データ)をセットで格納して、リストなどを作成するときに使用。Pythonでいうところのたぶん辞書型
Set Dic2 = CreateObject("Scripting.Dictionary")
On Error Resume Next
    
For i = 1 To 10

    name = Cells(i, 1).Value '荷受人の列の名前を1つずつ取得
    order_number = Cells(i, 2).Value '注文番号を1つずつ取得
    
    Dic.Add name & vbTab & order_number, "" ' Dicに追加していく
Next i


For Each tmp_var In Dic
    tmp_sp = Split(tmp_var, vbTab)
    If Dic2.Exists(tmp_sp(0)) Then
        Dic2.Item(tmp_sp(0)) = Dic2.Item(tmp_sp(0)) & "," & tmp_sp(1)
    Else
        Dic2.Add tmp_sp(0), tmp_sp(1)
    End If
Next

' 出力
myKeys = Dic2.Keys
For i = 0 To Dic2.Count - 1
    Range("C" & i + 1).Value = myKeys(i)
    Range("D" & i + 1).Value = Dic2.Item(myKeys(i))
Next i
'オブジェクトを開放する
Set Dic = Nothing

结束子

如何在 VBA 中的相同值旁边输出相同类型的值？

How do I output the same type of value in VBA next to the same value?

excel

vba

ms-office