使用 For 循环 VBA 选择多列和特定行

Question

我正在尝试根据 For 循环为 i 行选择多个列。这个想法是检查特定单元格是否符合标准。如果是这样，请将与该特定段关联的公式复制到与该观察相同的行。

即：

对于 i = 13

如果 O(i) = 段 A，将公式从 $P$1 复制并粘贴到 P(i)

与

将 T1:CV1 中的公式复制并粘贴到 T(i) : CV (i)

（请记住，T 和 CV 之间有隐藏的列，我认为这些与结果没有任何关系，因为它们是隐藏的，但无论如何都想注意。）

到目前为止，我已经尝试使用以下代码： Range("T" & i : "CV" & i).Select 。我知道这是错误的，但只是想给出一个想法。完整的代码附在下面。任何帮助表示赞赏！

Sub mastersheet()
 
Dim i As Integer
 
Sheets("Master").Select
 
For i = 13 To 400
    If Range("O" & i).Value = "A" Then
        Range("P1").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T1:CV1").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "B" Then
        Range("P2").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T2:CV2").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "C" Then
        Range("P3").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T3:CV3").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "D" Then
        Range("P4").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T4:CV4").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "E" Then
        Range("P5").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T5:CV5").Select
        Selection.Copy
       Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "F" Then
        Range("P6").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T6:CV6").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "G" Then
        Range("P7").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T7:CV7").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "H" Then
        Range("P8").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T8:CV8").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    ElseIf Range("O" & i).Value = "I" Then
        Range("P9").Select
        Selection.Copy
        Range("P" & i).Select
        ActiveSheet.Paste
        Range("T9:CV9").Select
        Selection.Copy
        Range("T" & i : "CV" & i).Select
        ActiveSheet.Paste
    End If
Next i
       
    
End Sub

Answer 1

看看Select Case

Sub mastersheet1()
 
    Dim i As Integer, ws As Worksheet, n As Integer

    Set ws = Sheets("Master")
    With ws
        For i = 13 To 400
            Select Case .Range("O" & i).Value2
                Case "A": n = 1
                Case "B": n = 2
                Case "C": n = 3
                Case "D": n = 4
                Case "E": n = 5
                Case "F": n = 6
                Case "G": n = 7
                Case "H": n = 8
                Case "I": n = 9
                Case Else: n = 0
            End Select
    
            If n > 0 Then
               .Range("P" & n).Copy .Range("P" & i)
               .Range("T" & n & ":CV" & n).Copy .Range("T" & i & ":CV" & i)
            End If
        Next
    End With
       
End Sub

Answer 2

复制/粘贴方法的问题在于它非常缓慢且效率低下。我宁愿使用数组。这是一个例子：

Sub mastersheet()
 
Dim i As Integer
Dim arr As Variant 'This is for storing the array
 
Sheets("Master").Select
 
For i = 13 To 400
    If Range("O" & i).Value = "A" Then
        'This is faster than copy/pasting
        Range("P" & i) = Range("P1")
        arr = Range("T1:CV1")
        Range("T" & i & ": CV" & i) = arr
    End If
Next i    
End Sub`

Answer 3

请尝试下一个压缩代码。它不需要任何选择：

Sub masterSheet()
 Dim sh As Worksheet, i As Long, arr, arrL, arrNo, mtch

 Set sh = Sheets("Master")
 arrL = Split("A,B,C,D,E,F,G,H,I", ",")    'the array used to match the cell value
 arrNo = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)  'the array to return row to be copyed (based on mtch)
 arr = sh.Range("O1:O400")                 'place the range in an array, for faster iteration
 Application.Calculation = xlCalculationManual    'calculate formula result only of the end
  For i = 13 To 400
     mtch = Application.match(arr(i, 1), arrL, 0) 'match the letter value
     If IsNumeric(mtch) Then                      'if a match exists:
        sh.Range("P" & arrNo(mtch - 1)).Copy Destination:=sh.Range("P" & i) 'use the index from arrNo
        sh.Range("T" & arrNo(mtch - 1) & ":CV" & arrNo(mtch - 1)).Copy sh.Range("T" & i) 'use the index from arrNo
     End If
  Next i
 Application.Calculation = xlCalculationAutomatic 'now calculate copied formulas
 MsgBox "Ready..."
End Sub