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