发个附件上来
给你做了个宏,只要点击按钮就行,用时约0。23秒,详见附件,
宏代码如下:
Sub xzm()
Dim i%, ir%, m&
Dim k
Dim arr(), b()
tt = Timer
ir = Range("a65536")。 End(xlUp)。Row
arr = Range("a2:d" & ir)
m = 1
For i = 1 To ir Step 2
k = 1
Do While k <= 3
ReDim Preserve b(1 To 3, 1 To m)
If k Mod 3 = 1 Then
b(1, m) = arr(i, 1)
b(2, m) = "左"
b(...全部
给你做了个宏,只要点击按钮就行,用时约0。23秒,详见附件,
宏代码如下:
Sub xzm()
Dim i%, ir%, m&
Dim k
Dim arr(), b()
tt = Timer
ir = Range("a65536")。
End(xlUp)。Row
arr = Range("a2:d" & ir)
m = 1
For i = 1 To ir Step 2
k = 1
Do While k <= 3
ReDim Preserve b(1 To 3, 1 To m)
If k Mod 3 = 1 Then
b(1, m) = arr(i, 1)
b(2, m) = "左"
b(3, m) = arr(i, 2)
k = k + 1
m = m + 1
ElseIf k Mod 3 = 2 Then
b(1, m) = ""
b(2, m) = "中"
b(3, m) = arr(i, 3)
k = k + 1
m = m + 1
ElseIf k Mod 3 = 0 Then
b(1, m) = ""
b(2, m) = "右"
b(3, m) = arr(i, 4)
k = k + 1
m = m + 1
End If
Loop
Next
Sheets("sheet2")。
Select
Cells。ClearContents
Range("a2:c" & m) = Application。Transpose(b)
MsgBox ("总用时" & Timer - tt & "秒")
End Sub。
收起
