[已解决]看看我的代码错在哪了？

lgzxmlg · 发表于 2012-1-14 09:55

雄鹰 · 发表于 2012-1-14 10:25

简明扼要的写上你的计算规则，结果要求，你目前存在的问题会有助于你尽快的解决问题。

dongqing1998 · 发表于 2012-1-14 10:53

根据你公式的意思重新写了一段代码，也不知道能不能满足你的要求：

Sub 累计()
  Dim iA&, iC&, arrA, arrC, s$, c%, brr()
  arrA = Sheet1.Range("a2:d" & Sheet1.Range("a65536").End(3).Row)
  arrC = Sheet3.Range("a3:a" & Sheet3.Range("a65536").End(3).Row)
  ReDim brr(1 To UBound(arrC), 1 To 5)
  s = "甲乙丙丁"
  For iC = 1 To UBound(arrC)
For iA = 1 To UBound(arrA)
   If arrA(iA, 3) > 0 Then
      If arrA(iA, 1) <= arrC(iC, 1) Then
      c = InStr(s, arrA(iA, 4))
      brr(iC, c) = brr(iC, c) + arrA(iA, 2)
      brr(iC, 5) = brr(iC, 5) + arrA(iA, 2)
      End If
   End If
Next
  Next
  With Range("b3").Resize(UBound(arrC), 5)
.ClearContents
.Value = brr
  End With
End Sub

sunjing-zxl · 发表于 2012-1-14 11:27

这个最佳答案由 sunjing-zxl 给出，感谢 sunjing-zxl 的回答。

单击隐藏图章

本帖最后由 sunjing-zxl 于 2012-1-14 11:29 编辑

Sub bbb()
Dim arr33(1 To 31, 1 To 5)
Dim a As String
Dim arr, arr1, arr3
Dim Row1 As Long, Row3 As Long, i As Long, j As Long
With Sheets("A")
Row1 = .Range("A65536").End(xlUp).Row
arr1 = .Range("A2:D" & Row1)
End With
With Sheets("C")
Row3 = .Range("A65536").End(xlUp).Row
arr3 = .Range("A3:A" & Row3)
a = "甲乙丙丁"
For i = 1 To UBound(arr3)
For J1 = 1 To UBound(arr1)
If arr1(J1, 3) > 0 Then
If arr1(J1, 1) = arr3(i, 1) Then
arr33(arr1(J1, 1), InStr(a, arr1(J1, 4))) = arr33(arr1(J1, 1), InStr(a, arr1(J1, 4))) + arr1(J1, 2)
arr33(arr1(J1, 1), 5) = arr33(arr1(J1, 1), 5) + arr1(J1, 2)
End If
End If
Next J1
Next i
arr = arr33
ReDim arr1(1 To UBound(arr), 1 To 5)
For i = 1 To UBound(arr)
For j = 1 To 5
If i = 1 Then
arr1(i, j) = arr(i, j)
Else
arr1(i, j) = arr(i, j) + arr1(i - 1, j)
End If
Next j
Next i
Range("G3").Resize(31, 5).ClearContents
Range("G3").Resize(UBound(arr1), 5) = arr1
End With
End Sub

复制代码

附件：

根据条件汇总求和和累计-sunjing.rar (34.12 KB, 下载次数: 6)

lgzxmlg · 发表于 2012-1-14 16:40

两位老师的代码都不错，我又学习到了两种方法，但我只能给一个最佳，还是要谢谢两位老师的帮助！{:321:}

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