参与一下。。。
- Sub ykcbf() '//2024.7.26
- arr = Sheets("Sheet1").UsedRange
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
- ReDim zrr(1 To 10000, 1 To UBound(arr, 2))
- For i = 2 To UBound(arr)
- If arr(i, 1) <> Empty Then
- m = m + 1
- For j = 1 To UBound(arr, 2)
- brr(m, j) = arr(i, j)
- Next
- End If
- Next
- For x = 1 To m
- n = n + 1
- For j = 1 To UBound(brr, 2)
- zrr(n, j) = brr(x, j)
- Next
- For j = 2 To UBound(brr, 2)
- If brr(x, j) <> Empty Then
- n = n + 1
- zrr(n, 1) = brr(x, j)
- End If
- Next
- Next
- With Sheets("Sheet2")
- .UsedRange.Offset(1).ClearContents
- .[a2].Resize(n, UBound(arr, 2)) = zrr
- End With
- MsgBox "OK!"
- End Sub
复制代码
|