|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 宏1()
Application.ScreenUpdating = False
Sheet2.Range("h2:j1000").ClearContents
Sheet3.Range("a1:z1000").ClearContents
On Error Resume Next
Sheet1.Activate
Cells.Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Rows("2:" & [a60000].End(xlUp).Row).Copy
Sheets("辅助表").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
arr = Sheet3.Range("a1").CurrentRegion
With Sheet2
For a = 1 To UBound(arr, 2)
For b = 2 To UBound(arr) Step 2
n = n + 1
.Cells(n + 1, "H") = arr(1, a)
.Cells(n + 1, "I") = arr(b, a)
.Cells(n + 1, "J") = arr(b + 1, a)
Next
Next
End With
Sheet2.Activate
Application.ScreenUpdating = True
End Sub |
|