Excel VBA中的列

Question

使用列展望循環，相對較新的循環，並有一些現有的代碼迴路這是令人難以置信的繁瑣：

Sub AdvanceWeek2() 

Application.ScreenUpdating = False 

' Victor 

    ' Week1 
    Range("V24:V124").Copy 
    Range("U24").PasteSpecial xlPasteValues 
    Range("V134:V234").Copy 
    Range("U134").PasteSpecial xlPasteValues 
    Range("V244:V334").Copy 
    Range("U244").PasteSpecial xlPasteValues 

    ' Week2 
    Range("W24:W124").Copy 
    Range("V24").PasteSpecial xlPasteValues 
    Range("W134:W234").Copy 
    Range("V134").PasteSpecial xlPasteValues 
    Range("W244:W334").Copy 
    Range("V244").PasteSpecial xlPasteValues 

    ' Week3 
    Range("W24:W124").ClearContents 
    Range("W134:W234").ClearContents 
    Range("W244:W334").ClearContents 

' Nick 

    ' Week1 
    Range("Z24:Z124").Copy 
    Range("Y24").PasteSpecial xlPasteValues 
    Range("Z134:Z234").Copy 
    Range("Y134").PasteSpecial xlPasteValues 
    Range("Z244:Z334").Copy 
    Range("Y244").PasteSpecial xlPasteValues 

    ' Week2 
    Range("AA24:AA124").Copy 
    Range("Z24").PasteSpecial xlPasteValues 
    Range("AA134:AA234").Copy 
    Range("Z134").PasteSpecial xlPasteValues 
    Range("AA244:AA334").Copy 
    Range("Z244").PasteSpecial xlPasteValues 

    ' Week3 
    Range("AA24:AA124").ClearContents 
    Range("AA134:AA234").ClearContents 
    Range("AA244:AA334").ClearContents 

然後，這被重複另一個11人，所以你可以看到如何繁瑣這得到。我將如何將其自動化到一個循環中以縮短代碼，並且如果需要做出小的更改，將來可以更輕鬆地進行編輯？

Answer 1

試試這個

Sub AdvanceWeek2() 
    Application.ScreenUpdating = False 
    Dim var1 As Long, var2 As Long, cnt As Long 
    Dim rng As Range 

    var1 = 22 'for Column V 
    var2 = 100 'random max number 
    cnt = 13 'no of people 
    For i = var1 To var2 
     Range(Cells(24, i), Cells(124, i)).Copy Cells(24, i - 1) 
     Range(Cells(134, i), Cells(234, i)).Copy Cells(134, i - 1) 
     Range(Cells(244, i), Cells(334, i)).Copy Cells(244, i - 1) 
     If i Mod 2 = 1 Then 
      Union(Range(Cells(24, i), Cells(124, i)), Range(Cells(134, i), Cells(234, i)), Range(Cells(244, i), Cells(334, i))).ClearContents 
      i = i + 2 
      cnt = cnt - 1 
      If cnt = 0 Then Exit For 
     End If 
    Next i 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

你必須在第一列數字，而不是列字母思考。
列U是第21列（U是字母表中的第21個字母）。

您可以使用Range("U24")或Cells(24,21)（行24，第21列）參考U24。
您通過爲範圍中的第一個和最後一個單元格指定一系列單元格，因此Range(Cells(24,21),Cells(124,21))將引用U24:U124，與編寫Range("U24:U124")的內容相同。

現在爲循環位。你想參考Victor的第21欄，Nick的第25欄，下一個人的第29欄等等。所以你會以4爲單位增加這個循環。你還需要在每個循環中引用不同的列 - 移動列2到第1列第3列到第2列並清除第3列。

這一段代碼將通過將值打印到直接窗口來顯示循環如何工作。它會返回21 0, 21 1, 25 0, 25 1, 29 0, 29 1

Sub Test() 

    Dim x As Long, y As Long 

    With ThisWorkbook.Worksheets("Sheet1") 
     For x = 21 To 29 Step 4 
      For y = 0 To 1 
       Debug.Print x; y 
      Next y 
     Next x 
    End With 

End Sub 

這些x和y的值需要在列引用中使用，看到你只想值我們可以做一個範圍的細胞平起平坐，而不是拷貝/ PasteSpecial的。

Sub Test() 

    Dim x As Long, y As Long 

    With ThisWorkbook.Worksheets("Sheet1") 
     For x = 21 To 29 Step 4 
      For y = 0 To 1 
       .Range(.Cells(24, x + y), .Cells(124, x + y)).Value = .Range(.Cells(24, x + y + 1), .Cells(124, x + y + 1)).Value 
       .Range(.Cells(134, x + y), .Cells(234, x + y)).Value = .Range(.Cells(134, x + y + 1), .Cells(234, x + y + 1)).Value 
       .Range(.Cells(244, x + y), .Cells(334, x + y)).Value = .Range(.Cells(244, x + y + 1), .Cells(334, x + y + 1)).Value 
      Next y 
      .Range(.Cells(24, x + y), .Cells(124, x + y)).ClearContents 
      .Range(.Cells(134, x + y), .Cells(234, x + y)).ClearContents 
      .Range(.Cells(244, x + y), .Cells(334, x + y)).ClearContents 
     Next x 
    End With 

End Sub 

添加手錶X & Y的值，並使用F8通過代碼。您會看到值增加以引用正確的列。

注意我使用了With..End With關鍵字。這意味着以.開頭的每個範圍都引用了包含代碼（ThisWorkbook）的工作簿的Sheet1。

編輯：
如果你要複製的細胞（包括格式，公式等），那麼你可以使用：

Sub Test() 

    Dim x As Long, y As Long 

    With ThisWorkbook.Worksheets("Sheet1") 
     For x = 21 To 29 Step 4 
      For y = 0 To 1 
       .Range(.Cells(24, x + y + 1), .Cells(124, x + y + 1)).Copy Destination:=.Range(.Cells(24, x + y), .Cells(124, x + y)) 
       .Range(.Cells(134, x + y + 1), .Cells(234, x + y + 1)).Copy Destination:=.Range(.Cells(134, x + y), .Cells(234, x + y)) 
       .Range(.Cells(244, x + y + 1), .Cells(334, x + y + 1)).Copy Destination:=.Range(.Cells(244, x + y), .Cells(334, x + y)) 
      Next y 
      Union(.Range(.Cells(24, x + y), .Cells(124, x + y)), _ 
        .Range(.Cells(134, x + y), .Cells(234, x + y)), _ 
        .Range(.Cells(244, x + y), .Cells(334, x + y))).ClearContents 
     Next x 
    End With 

End Sub 

（即聯合行會在第一個例子中使用，以及）。

Answer 3

從你的代碼看，用戶名不重要，只有12個用戶。

12個用戶，3周...

快速和最小碼的方法是：

環路通過您的代碼12次（一次爲每個用戶）。 每個用戶有3周的嵌套循環，對每個複製和粘貼操作應用一個偏移量到基準（或起始）列。

Sub AdvanceWeek2() 

Application.ScreenUpdating = False 

Dim intLoopUser As Integer 
Dim intLoopWeek As Integer 

Dim rngBase As Range 

Set rngBase = ActiveSheet.Range("V24:V124") 

For intLoopUser = 0 To 35 Step 3 '12 Users, change the Step as required, looked like 3 from your code, maybe 4 

    For intLoopWeek = 0 To 2 '3 weeks 

     Select Case intLoopWeek 
     Case 0 'Week 1 
      rngBase.Offset(0, (intLoopUser + intLoopWeek) - 1).Value = rngBase.Offset(0, intLoopUser + intLoopWeek).Value 
      rngBase.Offset(110, (intLoopUser + intLoopWeek) - 1).Value = rngBase.Offset(110, intLoopUser + intLoopWeek).Value 
      rngBase.Offset(210, (intLoopUser + intLoopWeek) - 1).Value = rngBase.Offset(210, intLoopUser + intLoopWeek).Value 
     Case 1 'Week 2 
      rngBase.Offset(0, (intLoopUser + intLoopWeek) - 1).Value = rngBase.Offset(0, intLoopUser + intLoopWeek).Value 
      rngBase.Offset(110, (intLoopUser + intLoopWeek) - 1).Value = rngBase.Offset(110, intLoopUser + intLoopWeek).Value 
      rngBase.Offset(210, (intLoopUser + intLoopWeek) - 1).Value = rngBase.Offset(210, intLoopUser + intLoopWeek).Value 
     Case 2 'Week 3 
      rngBase.Offset(0, (intLoopUser + intLoopWeek) - 1).ClearContents 
      rngBase.Offset(110, (intLoopUser + intLoopWeek) - 1).ClearContents 
      rngBase.Offset(210, (intLoopUser + intLoopWeek) - 1).ClearContents 

     End Select 

    Next intLoopWeek 

Next intLoopUser 

Application.ScreenUpdating = True 

End Sub