怎样统计出每个时间段不同支付方式的金额总和

Qs18

试试............

Qs18

试试...........

翁知江安

Sub tj1()
Dim i, j, k, h, hh, tt, m, irow, irow1
Dim ar, br As Variant
Dim d1 As Object
Set d1 = CreateObject("scripting.dictionary")
irow = Sheet1.[a100000].End(xlUp).Row
ar = Sheet1.Range("a1:j" & irow)
irow1 = Sheet1.[k100000].End(xlUp).Row
For i = 2 To irow
  h = Hour(ar(i, 6))
  If h = 24 Then
  hh = Format(h - 24, "00")
   ar(i, 10) = hh & ":00:00-" & hh & ":59:59"
   Else
     hh = Format(h, "00")
   ar(i, 10) = hh & ":00:00-" & hh & ":59:59"
  End If
  d1(ar(i, 10) & ar(i, 7)) = d1(ar(i, 10) & ar(i, 7)) + Val(ar(i, 3))
Next
ReDim br(1 To irow1 - 4, 1 To 3)
With Sheet1
For j = 5 To irow1
m = m + 1
  For k = 12 To 14
  If Len(.Cells(4, k)) > 4 Then
     tt = Left(.Cells(4, k), Len(.Cells(4, k)) - 2)
     Else
     tt = .Cells(4, k).Value
   End If
   br(m, k - 11) = d1(.Cells(j, 11).Value & tt)
  Next
Next
.[l5].Resize(UBound(br), 3) = br
End With
End Sub

今日123

借用老师的代码写的
Sub 汇总2() '汇总2
Dim r%, i%
Dim arr, brr, s, ss, n
Dim d As Object
Application.ScreenUpdating = False

Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
  r = .Cells(.Rows.Count, 1).End(xlUp).Row
  arr = .Range("a2:i" & r)
End With
For i = 1 To UBound(arr)
    If Len(arr(i, 6)) Then
        s = Format(arr(i, 6), "hh")
        ss = s & ":00:00-" & s & ":59:59"
    End If
    If Not d.exists(ss) Then
    ReDim brr(1 To 4)
    brr(1) = ss
  Else
    brr = d(ss)
  End If
  Select Case arr(i, 7)
    Case "微信支付"
      n = 2
    Case "支付宝支付"
      n = 3
    Case Else
      n = 4
  End Select
  brr(n) = brr(n) + Val(arr(i, 3))
  d(ss) = brr
Next
With Worksheets("sheet1")
  .Range("k2").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
End With
End Sub