|
参与一下。。。
- Sub ykcbf() '//2024.4.19
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- arr = Sheets("数据").UsedRange
- ReDim brr(1 To 1000000, 1 To 2)
- For j = 1 To UBound(arr, 2) Step 2
- For i = 2 To UBound(arr)
- If arr(i, j) <> Empty Then
- m = m + 1
- brr(m, 1) = arr(i, j)
- brr(m, 2) = arr(i, j + 1)
- End If
- Next
- Next
- With Sheets("结果")
- .[a1].Resize(1, 2).Interior.Color = 49407
- .UsedRange.Offset(1) = ""
- .[a2].Resize(m, 2) = brr
- .[a1].Resize(m + 1, 2).Borders.LineStyle = 1
- End With
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|