代码如下:- Sub ykcbf() '//2024.3.11
- Dim arr, d
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets("测试明细")
- r = .Cells(.Rows.Count, "a").End(xlUp).Row
- arr = .[a1].Resize(r, 10)
- End With
- ReDim brr(1 To UBound(arr), 1 To 7)
- ReDim zrr(1 To UBound(arr), 1 To 7)
- b = [{1,3,4,5,6,2,7}]
- For i = 4 To UBound(arr)
- If arr(i, 4) = Empty Then
- For j = 2 To 7
- arr(i, j) = arr(i - 1, j)
- Next
- Else
- n = n + 1
- For j = 1 To 7
- brr(n, j) = arr(i, b(j))
- Next
- End If
- s = arr(i, 4)
- d(s) = d(s) + arr(i, 10)
- Next
- For i = 1 To UBound(brr)
- t = d(brr(i, 3))
- If brr(i, 4) - t <> 0 Then
- m = m + 1
- zrr(m, 1) = m
- For j = 2 To 7
- zrr(m, j) = brr(i, j)
- Next
- zrr(m, 4) = zrr(m, 4) - t
- End If
- Next
- With Sheets("测试片库存")
- ' .UsedRange.Offset(2) = ""
- .Range("a3").Resize(m, 7) = zrr
- .Range("a3").Resize(m, 7).Borders.LineStyle = 1
- End With
- Set d = Nothing
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|