|
Sub test()
Dim A, B, i, j, k, s
Application.ScreenUpdating = False
ReDim B(1 To 10 ^ 4, 1 To 5)
For k = 1 To Sheets.Count - 1
Sheets(k).Select
A = Range("a2").CurrentRegion
For i = 3 To UBound(A)
For j = 4 To UBound(A, 2)
If A(i, j) <> "" Then
s = s + 1
B(s, 1) = A(i, 1) '日期
B(s, 2) = A(2, j) '姓名
B(s, 3) = A(i, 2) '款式
B(s, 4) = A(i, j) '数量
B(s, 5) = A(i, 3) '单价
End If
Next j
Next i
Next k
Sheets(Sheets.Count).Select
Rows("2:65536") = ""
Range("a2").Resize(s, UBound(B, 2)) = B
End Sub
测试3.rar
(28.51 KB, 下载次数: 3)
|
|