如何利用VBA求和？

mymotoe6 · 发表于 2022-2-5 09:29

如何求特定条件的和，并且放到相应位置处？谢谢！

3190496160 · 发表于 2022-2-5 10:11

Sub 求和()
Application.ScreenUpdating = False
Dim ar As Variant
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
zc = DatePart("ww", Date)
nf = Year(Date)
With Sheets("数据透视")
r = .Cells(Rows.Count, 2).End(xlUp).Row
If r < 5 Then MsgBox "数据透视为空": End
ar = .Range("a1:d" & r)
ReDim arr(1 To UBound(ar), 1 To 2)
For i = 6 To UBound(ar)
      If InStr(ar(i, 2), "L") > 0 Then
         ar(i, 1) = ar(i, 2)
      End If
      If Trim(ar(i, 1)) = "" Then
         ar(i, 1) = ar(i - 1, 1)
      End If
      If Val(Left(Trim(ar(i, 2)), 4)) = Val(nf) And Val(Mid(Trim(ar(i, 2)), 5, 2)) = zc Then
         t = d(Trim(ar(i, 1)))
         If t = "" Then
            k = k + 1
            d(Trim(ar(i, 1))) = k
            t = k
            arr(k, 1) = ar(i, 1)
         End If
         arr(t, 2) = arr(t, 2) + ar(i, 3)
      End If
Next i
rs = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Range("g6:h" & rs) = Empty
If k = "" Then MsgBox "没有" & zc & "的数据"
.[g6].Resize(k, 2) = arr
End With
MsgBox "ok!"
End Sub

3190496160 · 发表于 2022-2-5 10:11

Sub 求和()
Application.ScreenUpdating = False
Dim ar As Variant
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
zc = DatePart("ww", Date)
nf = Year(Date)
With Sheets("数据透视")
r = .Cells(Rows.Count, 2).End(xlUp).Row
If r < 5 Then MsgBox "数据透视为空": End
ar = .Range("a1:d" & r)
ReDim arr(1 To UBound(ar), 1 To 2)
For i = 6 To UBound(ar)
      If InStr(ar(i, 2), "L") > 0 Then
         ar(i, 1) = ar(i, 2)
      End If
      If Trim(ar(i, 1)) = "" Then
         ar(i, 1) = ar(i - 1, 1)
      End If
      If Val(Left(Trim(ar(i, 2)), 4)) = Val(nf) And Val(Mid(Trim(ar(i, 2)), 5, 2)) = zc Then
         t = d(Trim(ar(i, 1)))
         If t = "" Then
            k = k + 1
            d(Trim(ar(i, 1))) = k
            t = k
            arr(k, 1) = ar(i, 1)
         End If
         arr(t, 2) = arr(t, 2) + ar(i, 3)
      End If
Next i
rs = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Range("g6:h" & rs) = Empty
If k = "" Then MsgBox "没有" & zc & "的数据"
.[g6].Resize(k, 2) = arr
End With
MsgBox "ok!"
End Sub

3190496160 · 发表于 2022-2-5 10:12

自动求和.rar (140.82 KB, 下载次数: 8)

mymotoe6 · 发表于 2022-2-5 13:26

3190496160 发表于 2022-2-5 10:12

太感谢了，好好学习一下，还有个问题，您再给看一下，感谢！

3190496160 · 发表于 2022-2-6 13:07

'在左侧还有一列数据，请问下应当如何操作？感谢！
不知所云，一头雾水

mymotoe6 · 发表于 2022-2-13 14:16

3190496160 发表于 2022-2-6 13:07
'在左侧还有一列数据，请问下应当如何操作？感谢！
不知所云，一头雾水

自动求和.rar (154.83 KB, 下载次数: 2) 文件中有两组数据,请问如何操作?谢谢!

3190496160 · 发表于 2022-2-13 14:26

实在是不知道你的意思，加qq私聊吧

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