求助！想将明细表中的数据整理成汇总表样式

wang-way

wang-way

LIUZHU 发表于 2024-6-18 14:19
揽收提成部分，一般都是8列数据吧，对应的很清楚，投递计件部分，每一个小类，为什么不都设计成8列呢？

好繁琐是不是 看看我的做法 哈哈

LIUZHU

wang-way 发表于 2024-6-18 14:23
好繁琐是不是 看看我的做法 哈哈

不是很繁琐，我先得了解我觉得疑惑的地方

wang-way

LIUZHU 发表于 2024-6-18 14:24
不是很繁琐，我先得了解我觉得疑惑的地方

就是做表格太随性了   如果用JSA  应该少写很多代码

18947142575

LIUZHU 发表于 2024-6-18 14:19
揽收提成部分，一般都是8列数据吧，对应的很清楚，投递计件部分，每一个小类，为什么不都设计成8列呢？

可以的，怎么方便怎么来

18947142575

wang-way 发表于 2024-6-18 14:17

没想到会有这么复杂，果真学无止境

wang-way

ykcbf1100

名字还有这么多空白的。附件供参考。。。
关键字：分块处理

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.18
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("明细表").UsedRange
   
5.     For i = 1 To UBound(arr)
   
6.         If InStr(arr(i, 1), "揽投岗位计件工资核算表") Then k = k + 1: d(k) = i
   
7.     Next
   
8.     ReDim brr(1 To UBound(arr), 1 To 100)
   
9.     On Error Resume Next
   
10.     t = d.items
    
11.     For k = 1 To d.Count
    
12.         r1 = d(k)
    
13.         If k = d.Count Then r2 = r Else r2 = d(k + 1) - 1
    
14.         c = 0
    
15.         m = m + 1
    
16.         For i = r1 To r2
    
17.             For x = 1 To 9
    
18.                 c = c + 1
    
19.                 brr(m, c) = arr(i + 5, x)
    
20.             Next
    
21.             For x = 4 To 11
    
22.                 c = c + 1
    
23.                 brr(m, c) = arr(i + 8, x)
    
24.             Next
    
25.             For x = 4 To 9
    
26.                 c = c + 1
    
27.                 brr(m, c) = arr(i + 11, x)
    
28.             Next
    
29.             For x = 4 To 9
    
30.                 c = c + 1
    
31.                 brr(m, c) = arr(i + 14, x)
    
32.             Next
    
33.             '**************************
    
34.             For x = 12 To 20
    
35.                 c = c + 1
    
36.                 brr(m, c) = arr(i + 5, x)
    
37.             Next
    
38.             For x = 13 To 20
    
39.                 c = c + 1
    
40.                 brr(m, c) = arr(i + 8, x)
    
41.             Next
    
42.             For x = 13 To 20
    
43.                 c = c + 1
    
44.                 brr(m, c) = arr(i + 11, x)
    
45.             Next
    
46.             For x = 13 To 20
    
47.                 c = c + 1
    
48.                 brr(m, c) = arr(i + 14, x)
    
49.             Next
    
50.         Next
    
51.     Next
    
52.     With Sheets("汇总")
    
53.         .UsedRange.Offset(3).Clear
    
54.         With .[a4].Resize(m, 62)
    
55.             .Value = brr
    
56.             .Borders.LineStyle = 1
    
57.             .HorizontalAlignment = xlCenter
    
58.             .VerticalAlignment = xlCenter
    
59.         End With
    
60.         ActiveWindow.DisplayZeros = False
    
61.     End With
    
62.     Set d = Nothing
    
63.     Application.ScreenUpdating = True
    
64.     MsgBox "OK！"
    
65. End Sub
    
66. 
    

复制代码

wengjl

对明细表和汇总，各取前半部分，作了测试，成功，代码很少。
关键是增加了一张 对应 表，将二表的对应字段列上，列号填上，加明细上的行相对位置数也列上，
就可以了

Sub ss()
    '2024-6-18 https://club.excelhome.net/thread-1695104-2-1.html
    Sheet2.Select
    jsh = Sheet1.UsedRange.Rows.Count    ' 依据数据范围，获得行数，
    x2 = 4
    For x1 = 1 To jsh
      aa = Sheet1.Cells(x1, 1).Value
      If Mid(aa, 1, 3) = "单位：" Then
        For k = 2 To 30
          y2 = Sheet3.Cells(k, 3).Value
          y1 = Sheet3.Cells(k, 5).Value
          mdd = Sheet3.Cells(k, 6).Value
          Sheet2.Cells(x2, y2).Value = Sheet1.Cells(x1 + mdd, y1).Value
        Next k
        x2 = x2 + 1
      End If
    Next x1
End Sub