曾经的回帖整理-字典案例部分

sunnyliner2018

版主：遇到用字典从2个不同排列的工作表汇总数据的问题。
从一个表中汇总就会用，多一个增加的指定表就不知道该如何实现的。
请帮忙看一 下。https://club.excelhome.net/thread-1626468-1-1.html

Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("DATA")
      ar = .[a1].CurrentRegion
End With
For i = 2 To UBound(ar)
      If Trim(ar(i, 1)) <> "" Then
          d(Trim(ar(i, 1))) = i
      End If
Next i
With Sheets("DATA2")
      ar = .[a1].CurrentRegion
End With
For i = 2 To UBound(ad)
      If Trim(ad(i, 1)) <> "" Then
          d(Trim(ad(i, 1))) = i
      End If
Next i
With Sheets("ZBTQ")
      rs = .Cells(Rows.Count, 1).End(xlUp).Row
      .Range("c2:e" & rs + 1) = Empty
      br = .Range("a1:f" & rs)
      For i = 2 To UBound(br)
          If Trim(br(i, 2)) <> "" Then
              xh = d(Trim(br(i, 2)))
              If xh <> "" Then
                  br(i, 3) = Val(ar(xh, 3))
                  br(i, 4) = Val(ar(xh, 4))
                  br(i, 5) = ar(xh, 10)
                  br(i, 3) = Val(ad(xh, 11))  '报错
                 br(i, 4) = Val(ad(xh, 3)) '报错
                 br(i, 5) = ad(xh, 6) '报错

             End If
          End If
      Next i
      .Range("a1:f" & rs) = br
End With
MsgBox "ok!"
End Sub


谢谢！

前进者

标记一下以便学习备用！

chenjy267

liulang0808 发表于 2018-1-4 07:50
根据AB两列，对后面的数据进行汇总

字典和数组

艾亚Arya

liulang0808 发表于 2017-12-17 19:34
以A,B列数据为关键字，统计数量汇总
使用字典直接以两列为关键字，进行累加

大神，在学习您的代码，不理解第14行代码的含义，求教，谢谢。

a63946023

谢谢版主,学习学习

liulang0808

艾亚Arya 发表于 2022-5-30 19:26
大神，在学习您的代码，不理解第14行代码的含义，求教，谢谢。

具体哪段代码的？

艾亚Arya

liulang0808 发表于 2022-5-31 11:36
具体哪段代码的？

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("原始数据").[a1].CurrentRegion
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.ClearContents
    For j = 2 To UBound(arr)
        d(arr(j, 1) & "#" & arr(j, 2)) = d(arr(j, 1) & "#" & arr(j, 2)) + arr(j, 3)
    Next j
   
    If d.Count > 0 Then
        [a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
        [c2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
    End If
    Columns("A:A").TextToColumns Destination:=Range("A1"), OtherChar:="#"
    [a1:c1].Value = Sheets("原始数据").[a1:c1].Value
    Application.ScreenUpdating = True
End Sub

liulang0808

艾亚Arya 发表于 2022-5-31 11:54
Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("原始数据"). ...

对照着附件看吧，
A列以#好来分列

scnc001

点赞，支持

张三丰0515

占楼，路过，下载过
收藏，留言，我来过