|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub AwTest()
Dim i&, eRow&, FxVal%, KsRow&, s, arr
With Sheet1
eRow = .Cells(Rows.Count, 1).End(3).Row
arr = .Range("A3:B" & eRow)
ReDim brr(1 To UBound(arr) + 1, 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 2) Then
If arr(i, 2) <> FxVal Then
FxVal = arr(i, 2)
If KsRow Then
brr(i, 1) = (arr(i, 1) - arr(KsRow, 1)) * arr(KsRow, 2)
s = s + brr(i, 1)
End If
KsRow = i
End If
End If
Next
brr(UBound(brr), 1) = s
.[D3].Resize(UBound(brr)) = brr
End With
End Sub |
|