统计每月数据

a1999zqw

表1是每天的数据，要汇总到表2，列数比较多，麻烦老师了，谢谢

工作簿1.rar (11.91 KB, 下载次数: 16)

2024-3-3 22:30 上传

点击文件名下载附件

yynrzwh

工作簿1.zip (22.51 KB, 下载次数: 14)

2024-3-3 22:59 上传

点击文件名下载附件

朝露孤烟

表2=SUM(IF(--LEFT(Sheet1!$A$2:$A$14,6)=$A2,--Sheet1!C$2:C$14))，下拉，右拉。

ykcbf1100

字典+数组

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.4
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("Sheet1")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         c = .UsedRange.Columns.Count
   
8.         arr = .[a1].Resize(r, c)
   
9.     End With
   
10.     For i = 2 To UBound(arr)
    
11.         For j = 3 To UBound(arr, 2)
    
12.             s = Left(arr(i, 1), 6) & "|" & arr(1, j)
    
13.             d(s) = d(s) + arr(i, j)
    
14.         Next
    
15.     Next
    
16.     t = d.items
    
17.     With Sheets("Sheet2")
    
18.         arr = .UsedRange
    
19.         For i = 2 To UBound(arr)
    
20.             For j = 2 To UBound(arr, 2)
    
21.                 s = arr(i, 1) & "|" & arr(1, j)
    
22.                 If d.Exists(s) Then
    
23.                     arr(i, j) = d(s)
    
24.                 End If
    
25.             Next
    
26.         Next
    
27.         .UsedRange = arr
    
28.         .UsedRange.Borders.LineStyle = 1
    
29.         ActiveWindow.DisplayZeros = False
    
30.     End With
    
31.     Set d = Nothing
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码

A刘志勇

你参考一下。

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, k&
   
    br = Sheets(1).[A1].CurrentRegion
    With [A1].CurrentRegion
        .Offset(1, 1).ClearContents
        ar = .Value
        For i = 2 To UBound(ar)
            For k = 2 To UBound(br)
                If Left(br(k, 1), 6) = CStr(ar(i, 1)) Then
                     For j = 3 To UBound(br, 2)
                         If Len(br(k, j)) Then
                              ar(i, j - 1) = ar(i, j - 1) + br(k, j)
                         End If
                     Next j
                End If
            Next k
        Next i
        .Value = ar
    End With
   
    Beep
End Sub

gwjkkkkk

请参考。。。

shiruiqiang

练个手吧，自动汇总行列