要求很怪異,但是還是滿足你,VBA程式碼如下。執行的速度很快,是看不到拖動的過程的。Sub t1() Dim A1(1 To 30) As String, i As Integer, Rg As Range, R As Integer For Each Rg In Range("C2:H6").Cells A1(Rg.Value) = Rg.Address Next i = 0 "W5至Z5單元格有什麼數就從C2:H6單元格拖動到L5:O5單元格 For i = 0 To 3 R = Range("W5").Offset(0, i).Value Range(A1(R)).Cut Range("L6").Offset(0, i) Next "恢復C2:H6單元格原1到30數字 Range("C2:H6").Borders.LineStyle = xlContinuous For i = 0 To 3 R = Range("W5").Offset(0, i).Value Range(A1(R)).Value = R Next "W6至Z6單元格有什麼數就從C2:H6單元格拖動到R5:U5單元格 For i = 0 To 3 R = Range("W6").Offset(0, i).Value Range(A1(R)).Cut Range("R6").Offset(0, i) Next Range("C2:H6").Borders.LineStyle = xlContinuousEnd Sub
要求很怪異,但是還是滿足你,VBA程式碼如下。執行的速度很快,是看不到拖動的過程的。Sub t1() Dim A1(1 To 30) As String, i As Integer, Rg As Range, R As Integer For Each Rg In Range("C2:H6").Cells A1(Rg.Value) = Rg.Address Next i = 0 "W5至Z5單元格有什麼數就從C2:H6單元格拖動到L5:O5單元格 For i = 0 To 3 R = Range("W5").Offset(0, i).Value Range(A1(R)).Cut Range("L6").Offset(0, i) Next "恢復C2:H6單元格原1到30數字 Range("C2:H6").Borders.LineStyle = xlContinuous For i = 0 To 3 R = Range("W5").Offset(0, i).Value Range(A1(R)).Value = R Next "W6至Z6單元格有什麼數就從C2:H6單元格拖動到R5:U5單元格 For i = 0 To 3 R = Range("W6").Offset(0, i).Value Range(A1(R)).Cut Range("R6").Offset(0, i) Next Range("C2:H6").Borders.LineStyle = xlContinuousEnd Sub