统计每月数据

a1999zqw · 发表于 2024-3-3 22:30

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

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

yynrzwh · 发表于 2024-3-3 22:59

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

朝露孤烟 · 发表于 2024-3-4 00:12

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

ykcbf1100 · 发表于 2024-3-4 11:08

字典+数组

ykcbf1100 · 发表于 2024-3-4 11:08

参与一下。。。

Sub ykcbf() '//2024.3.4
Dim arr, d
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
r = .Cells(.Rows.Count, "a").End(xlUp).Row
c = .UsedRange.Columns.Count
arr = .[a1].Resize(r, c)
End With
For i = 2 To UBound(arr)
For j = 3 To UBound(arr, 2)
s = Left(arr(i, 1), 6) & "|" & arr(1, j)
d(s) = d(s) + arr(i, j)
Next
Next
t = d.items
With Sheets("Sheet2")
arr = .UsedRange
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
s = arr(i, 1) & "|" & arr(1, j)
If d.Exists(s) Then
arr(i, j) = d(s)
End If
Next
Next
.UsedRange = arr
.UsedRange.Borders.LineStyle = 1
ActiveWindow.DisplayZeros = False
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

A刘志勇 · 发表于 2024-3-4 11:55

你参考一下。

gwjkkkkk · 发表于 2024-3-4 20:22

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 · 发表于 2024-3-4 20:23

请参考。。。

shiruiqiang · 发表于 2024-3-4 22:23

练个手吧，自动汇总行列

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

[求助] 统计每月数据

评分

评分