|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub 按钮1_Click()
- Dim arr, brr(1 To 1000, 1 To 4)
- Set d = CreateObject("Scripting.Dictionary")
- Sheet1.Activate
- arr = [a1].CurrentRegion.Value
- For i = 2 To UBound(arr)
- mx = arr(i, 25) & arr(i, 20) & arr(i, 29)
- If Not d.exists(mx) Then
- n = n + 1
- d(mx) = n
- brr(n, 1) = arr(i, 25)
- brr(n, 2) = arr(i, 20)
- If arr(i, 29) = "(出账)" Then
- brr(n, 3) = arr(i, 16)
- Else
- brr(n, 4) = arr(i, 16)
- End If
- Else
- m = d(mx)
- If arr(i, 29) = "(出账)" Then
- brr(m, 3) = brr(m, 3) + arr(i, 16)
- Else
- brr(m, 4) = brr(m, 4) + arr(i, 16)
- End If
- End If
- Next
- Worksheets("求和").Activate
- [a2].Resize(n, 4) = brr
- End Sub
复制代码 |
|