|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub test()
- Dim mxr1, mxr2 As Long
- Dim arr1, arr2(1 To 100000, 1 To 6), arr3
- mxr1 = Sheets("原始订单表").[b60000].End(xlUp).Row
- mxr2 = Sheets("订单表").[b60000].End(xlUp).Row
- arr1 = Sheets("原始订单表").Range("b4:j" & mxr1)
- m = 0
- For i = 1 To UBound(arr1)
- m = m + 1
- For j = 5 To 9
- mm = mm + 2
- If arr1(i, j) > 0 Then
- arr2(m, 5) = mm
- arr2(m, 6) = arr1(i, j)
- Else
- GoTo 100
- End If
- For k = 1 To 4
- arr2(m, k) = arr1(i, k)
- Next k
- m = m + 1
- 100
- Next j
- mm = 0
- Next i
- ReDim arr3(1 To m, 1 To 6)
- For i = 1 To m
- If arr2(i, 1) > 0 Then
- t = t + 1
- For h = 1 To 6
- arr3(t, h) = arr2(i, h)
- Next h
- End If
- Next i
- Sheets("订单表").Range("a3").Resize(m, 6) = arr3
- End Sub
复制代码 |
|