[已解决][求助]请用字典方法把2个工作表的数据进行分类汇总

168216130B · 发表于 2008-6-30 16:15

用字典方法把2个工作表的数据进行分类汇总。

要求请看附件SHEET3表。

yuwyBmbs.rar (5.89 KB, 下载次数: 59)

劫-后-余-生 · 发表于 2008-7-1 11:02

Sub BU()
Dim arr1(), arr2(), i1 As Integer, i2 As Integer
Dim dic As New Dictionary
Sheet3.Select
i1 = [a65536].End(xlUp).Row
arr1 = Range("a3:a" & i1)
Range("b3:e" & i1).Clear
arr2 = Range("b3:e" & i1)
For i1 = 1 To UBound(arr1)
   dic(arr1(i1, 1)) = i1
Next i1
Sheet1.Select
i1 = [a65536].End(xlUp).Row
arr1 = Range("a2:c" & i1)
For i1 = 1 To UBound(arr1)
   If dic.Exists(arr1(i1, 1)) Then
      If arr1(i1, 2) = "个" Then
         arr2(dic(arr1(i1, 1)), 1) = arr2(dic(arr1(i1, 1)), 1) + arr1(i1, 3)
      Else
         arr2(dic(arr1(i1, 1)), 2) = arr2(dic(arr1(i1, 1)), 2) + arr1(i1, 3)
      End If
    End If
Next i1
Sheet2.Select
i1 = [a65536].End(xlUp).Row
arr1 = Range("a2:c" & i1)
For i1 = 1 To UBound(arr1)
   If dic.Exists(arr1(i1, 1)) Then
      If arr1(i1, 2) = "个" Then
         arr2(dic(arr1(i1, 1)), 3) = arr2(dic(arr1(i1, 1)), 3) + arr1(i1, 3)
      Else
         arr2(dic(arr1(i1, 1)), 4) = arr2(dic(arr1(i1, 1)), 4) + arr1(i1, 3)
      End If
    End If
Next i1
Sheet3.Select
[b3].Resize(dic.Count, 4) = arr2
End Sub
此代码未将第一、二张表中有而第三张表中无的名称计入

168216130B · 发表于 2008-7-1 12:25

学习下。

兰色幻想 · 发表于 2008-7-1 12:27

来晚了[em04]

蓝桥玄霜 · 发表于 2008-7-1 12:47

Mr7HFspY.rar (14.16 KB, 下载次数: 102)

168216130B · 发表于 2008-7-1 13:15

谢谢各位老师了。

laosanjie · 发表于 2008-7-1 15:23

来学习一下！

zsd5237 · 发表于 2008-7-2 05:51

学习

		自动登录	找回密码
密码			注册

[已解决][求助]请用字典方法把2个工作表的数据进行分类汇总

回复：（168216130B）[求助]请用字典方法把2个工作表的...