加急!!!求助大神，根据同日期与不同品种，生成明细

dnvjfdeuff

求助大神，根据同日期与不同品种，生成明细

shiruiqiang

===========

dnvjfdeuff

非常感谢大神指导

ykcbf1100

练习一下，全表自动生成。。。

ykcbf1100

练习一下。。。

1. Sub ykcbf()   '//2024.7.21    表格汇总
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     m = 2: n = 1
   
7.     On Error Resume Next
   
8.     With Sheets("Sheet1")
   
9.         r = .Cells(Rows.Count, 1).End(3).Row
   
10.         c = .UsedRange.Columns.Count
    
11.         arr = .[a1].Resize(r, c)
    
12.     End With
    
13.     brr(1, 1) = arr(1, 6)
    
14.     brr(1, 2) = arr(1, 5)
    
15.     For i = 2 To UBound(arr)
    
16.         s = arr(i, 7)
    
17.         If Not d.exists(s) Then
    
18.             m = m + 1
    
19.             d(s) = m
    
20.             brr(m, 1) = s
    
21.         End If
    
22.         r = d(arr(i, 7))
    
23.         s = arr(i, 5)
    
24.         If Not d.exists(s) Then
    
25.             n = n + 1
    
26.             d(s) = n
    
27.             brr(2, n) = s
    
28.         End If
    
29.         c = d(arr(i, 5))
    
30.         brr(r, c) = brr(r, c) + arr(i, 8)
    
31.     Next
    
32.     n = n + 1
    
33.     brr(1, n) = "备注"
    
34.     With Sheets("Sheet2")
    
35.         .UsedRange.Clear
    
36.         .Cells.Interior.ColorIndex = 0
    
37.         .[a1].Resize(2, n).Interior.Color = 49407
    
38.         .[a3].Resize(m - 2, 1).Interior.Color = 5296274
    
39.         With .[a1].Resize(m, n)
    
40.             .Value = brr
    
41.             .Borders.LineStyle = 1
    
42.             .HorizontalAlignment = xlCenter
    
43.             .VerticalAlignment = xlCenter
    
44.             With .Font
    
45.                 .Name = "微软雅黑"
    
46.                 .Size = 11
    
47.             End With
    
48.         End With
    
49.         .[a1].Resize(2).Merge
    
50.         .[b1].Resize(, n - 2).Merge
    
51.         .Cells(1, n).Resize(2).Merge
    
52.     End With
    
53.     Application.ScreenUpdating = True
    
54.     MsgBox "OK！"
    
55. End Sub
    

复制代码

dnvjfdeuff

ykcbf1100 发表于 2024-7-21 13:33
练习一下。。。

非常感谢大神指点

chxw68

学习。。。。

木槿花西月锦绣

练习

一招秒杀

这么简单的，把三个字段 分别拖入 透视表的三个区域，只需1秒，瞬间搞定。

saghj