时间戳

首页 > 解决方案 > 获取字典对象的项

excel - 获取字典对象的项

问题描述

在 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

我可以毫无问题地拿到钥匙，但如何退回物品。项目应该是 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

标签： excelvba

解决方案

您必须遍历数组中的每个条目才能将这些名称返回到工作表中。这是一个例子：

Option Explicit

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
        
        Dim dest As Range
        Set dest = .Range("J1")
        Dim entry As Variant
        For Each entry In dic.keys
            Dim names As Variant
            names = dic(entry)
            
            dest.Offset(0, 0).Value = entry
            For i = LBound(names) To UBound(names)
                dest.Offset(0, i + 1).Value = names(i)
            Next i
            Set dest = dest.Offset(1, 0)
        Next entry
    End With
End Sub

推荐阅读