excel - 获取字典对象的项

Question

在 sheet1 中，我有 6 列中的数据

这是我对代码的尝试

    Sub Test()
    Dim a, dic As Object, i As Long, ii As Long
    With Sheet1
    a = .Range("A1").CurrentRegion.Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a, 1)
        If Not dic.Exists(a(i, 2)) Then
        dic(a(i, 2)) = Array(a(i, 3), a(i, 4), a(i, 5), a(i, 6))
        Else
        For ii = 0 To 3
            If dic(a(i, 2))(ii) = Empty Then
                dic(a(i, 2))(ii) = a(i, ii + 3)
            End If
        Next ii
        End If
    Next i
    .Range("J1").Resize(dic.Count, 1).Value = Application.Transpose(dic.Keys)
    .Range("K1").Resize(dic.Count, 4).Value = dic.Items
End With
End Sub

我可以毫无问题地拿到 key ，但如何退回元素。项目应该是 C2:F11 中的名称
例如:

Name1 Ahmed Khaled Empty Amany

另一个例子:

Name2 Ahmed Khaled Reda Amany

只有当数组项内没有数据时，目标才能为每个唯一名称加入数据。
** 我想我可以在评论的帮助下解决它，如果有任何注释请告诉我

Sub Test()
    Dim a, w, dic As Object, i As Long, ii As Long
    With Sheet1
    a = .Range("A1").CurrentRegion.Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a, 1)
        If Not dic.Exists(a(i, 2)) Then
        dic(a(i, 2)) = Array(a(i, 3), a(i, 4), a(i, 5), a(i, 6))
        Else
        w = dic(a(i, 2))
        For ii = 0 To 3
            If w(ii) = Empty Then
                w(ii) = a(i, ii + 3)
            End If
        Next ii
        dic(a(i, 2)) = w
        End If
    Next i
    .Range("J1").Resize(dic.Count, 1).Value = Application.Transpose(dic.Keys)
    .Range("K1").Resize(dic.Count, 4).Value = Application.Transpose(Application.Transpose(dic.Items))
End With
End Sub

Answer 1

转置数据

这是将字典的项目用作“Redim Preserve”项目数组中的列。

Option Explicit

Sub Test()
    
    Dim ws As Worksheet: Set ws = Sheet1
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
    Dim sData As Variant: sData = srg.Value
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim iData() As Variant
    Dim Key As Variant
    Dim n As Long
    Dim sr As Long
    Dim ir As Long
    Dim ic As Long
    
    For sr = 1 To UBound(sData, 1)
        Key = sData(sr, 2)
        If Not dict.Exists(Key) Then
            n = n + 1
            dict(Key) = n
            ReDim Preserve iData(1 To 4, 1 To n) ' add another column
            For ir = 1 To 4
                iData(ir, n) = sData(sr, ir + 2)
            Next ir
        Else
            ic = dict(Key) ' write the column of the current Key to a variable
            For ir = 1 To 4
                If IsEmpty(iData(ir, ic)) Then
                    iData(ir, ic) = sData(sr, ir + 2)
                End If
            Next ir
        End If
    Next sr
    
    ws.Range("J1").Resize(dict.Count).Value = Application.Transpose(dict.Keys)
    ws.Range("K1").Resize(n, 4).Value = Application.Transpose(iData)

End Sub