关于数据字典

无穷大 · 发表于 2018-10-3 21:12

在Sheet1有下面的数据，如何使用数据字典，按照型号，单价，税率，备注1，备注2，进行，数量与金额的汇总
并且按照税率，拆分为2个表，放在Sheet2中，希望的结果如图2

型号	数量	单价	金额	税率	备注1	备注2
A	20	17	340	0	aac	BBC
A	30	18	540	0	aac	BBC
A	10	17	170	0	aac	BBC
A	10	18	180	5	aac	BBC
A	20	19	380	5	aac	BBC

图2

型号	数量	单价	金额	税率	备注1	备注2
A	30	17	510	0	aac	BBC
A	30	18	540	0	aac	BBC

型号	数量	单价	金额	税率	备注1	备注2
A	10	18	180	5	aac	BBC
A	20	19	380	5	aac	BBC

yxbaju · 发表于 2018-10-3 21:19

上传个附件，你的这个分类用字典，用SQL都可以

无穷大 · 发表于 2018-10-3 21:23

附件已上传，如果不是按照税率分开，还可以搞定，但是分开了，就不会了

abc123281 · 发表于 2018-10-3 21:43

数据量太少没有编写代码的价值

唐朝123 · 发表于 2018-10-3 21:54

数据太少，字典的key你想用型号还是单价呢？看不懂

abc123281 · 发表于 2018-10-3 22:03

我能看懂的  就是按照税率来拆分  其他的不知道
Sub test()
Dim arr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:g" & r)
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 5)) Then
      Set d(arr(i, 5)) = .Range("a1").Resize(1, 7)
   End If
      Set d(arr(i, 5)) = Union(d(arr(i, 5)), .Cells(i, 1).Resize(1, 7))
Next
End With
With Worksheets("sheet3")
.Cells.Clear
  For Each aa In d.keys
If .Cells(1, 1) = "" Then
   r = 1
Else
   r = .[a65536].End(xlUp).Row + 2
End If
   d(aa).Copy .Range("a" & r)
Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "数据拆分完毕！", vbInformation
End Sub

abc123281 · 发表于 2018-10-3 22:04

工作簿123.rar (14.58 KB, 下载次数: 43)

yxbaju · 发表于 2018-10-3 22:11

本帖最后由 yxbaju 于 2018-10-3 22:13 编辑

数据透视即可实现你的需求

无穷大 · 发表于 2018-10-3 22:54

yxbaju 发表于 2018-10-3 22:11
数据透视即可实现你的需求

你没有理解我的问题，数据透视我会用

无穷大 · 发表于 2018-10-3 22:55

abc123281 发表于 2018-10-3 22:04

谢谢，就是要的这个结果

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

[求助] 关于数据字典