求助大神帮忙写个代码下

hongmeili

数据源中以不同的SPU进行分行，下单数量统计，全国30日出库销量，全国可用库存，在进行求和，并带上公式。想要“下单数据”的模版，麻烦老师帮忙看看。谢谢啦

ykcbf1100

带图片，应该会比较麻烦。
如果没有图片，简单。

hongmeili

ykcbf1100 发表于 2024-8-22 16:22
带图片，应该会比较麻烦。
如果没有图片，简单。

可以不带图片哈，麻烦啦

ykcbf1100

hongmeili 发表于 2024-8-22 16:51
可以不带图片哈，麻烦啦

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()    '//2024.8.22
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ReDim zrr(1 To 1000)
   
6.     Set sh = ThisWorkbook.Sheets("下单数据")
   
7.     sh.UsedRange.Offset(1).Clear
   
8.     sh.UsedRange.UnMerge
   
9.     With Sheets("数据源")
   
10.         r = .Cells(Rows.Count, 1).End(3).Row
    
11.         arr = .[a1].Resize(r, 14)
    
12.         For i = 2 To UBound(arr)
    
13.             If arr(i, 2) <> arr(i - 1, 2) Then M = M + 1: zrr(M) = Array(i, i)
    
14.             If i = r Then zrr(M)(1) = r
    
15.             If i < r Then
    
16.                 If arr(i, 2) = arr(i - 1, 2) And arr(i, 2) <> arr(i + 1, 2) Then zrr(M)(1) = i
    
17.             End If
    
18.         Next
    
19.         For x = 1 To M
    
20.             r1 = zrr(x)(0): r2 = zrr(x)(1)
    
21.             n = r2 - r1 + 1
    
22.             Set Rng = .Cells(r1, 1).Resize(n, 14)
    
23.             If x = 1 Then
    
24.                 Rng.Copy sh.[b2]
    
25.             Else
    
26.                 r = sh.Cells(Rows.Count, 3).End(3).Row
    
27.                 Rng.Copy sh.Cells(r + 2, 2)
    
28.             End If
    
29.             sh.Cells(r2 + x, 1).Resize(, 15).Interior.ColorIndex = 6
    
30.             sh.Cells(r2 + x, 2) = "小计"
    
31.             For j = 13 To 15
    
32.                 sh.Cells(r2 + x, j) = Application.Sum(sh.Cells(r1 + x - 1, j).Resize(n))
    
33.             Next
    
34.         Next
    
35.     End With
    
36.     With sh
    
37.         r = .Cells(Rows.Count, 2).End(3).Row
    
38.         .Cells(r + 2, 2) = "合计数量"
    
39.         With .[a1].Resize(r + 2, 15)
    
40.             .Borders.LineStyle = 1
    
41.             .HorizontalAlignment = xlCenter
    
42.             .VerticalAlignment = xlCenter
    
43.         End With
    
44.         For j = 8 To 10
    
45.             .Cells(r + 2, j) = Application.Sum(sh.Cells(2, j).Resize(r))
    
46.         Next
    
47.         .Cells(r + 2, 13) = Application.Sum(sh.Cells(r + 2, 8).Resize(, 3))
    
48.     End With
    
49.     Application.ScreenUpdating = True
    
50. End Sub
    

复制代码

hongmeili

ykcbf1100 发表于 2024-8-22 18:16
附件供参考。。。

非常的感谢哈~~