|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub mml()
- Dim arr, brr, i&, j&, k&, n&, myr&
- myr = ActiveSheet.Index
- ReDim brr(1 To Cells.Rows.Count, 1 To 7)
- For i = 1 To myr - 1
- arr = Sheets(i).[b3].CurrentRegion
- For j = 4 To UBound(arr)
- For n = 4 To UBound(arr, 2)
- If arr(2, n) = "" Then arr(2, n) = arr(2, n - 1)
- If arr(2, n) <> "小计" Then
- k = k + 1
- brr(k, 1) = arr(j, 1)
- brr(k, 2) = arr(j, 2)
- brr(k, 3) = arr(j, 3)
- brr(k, 4) = Sheets(i).Name
- brr(k, 5) = arr(2, n)
- brr(k, 6) = arr(3, n)
- brr(k, 7) = arr(j, n)
- End If
- Next
- Next
- Next
- Range("b5:h" & Cells.Rows.Count).ClearContents
- [b5].Resize(k, 7) = brr
- End Sub
复制代码 |
|