Question

下面的代码（代码一）目前工作正常，其中选定的列是copy＆amp;粘贴在A栏中的单一标准。

但是，我正在尝试添加另一个条件，如果列N到R为空，则excel不会复制单元格。我尝试编写Code Two（下面）但得到运行时错误＆＃39; 9＆＃39;下标超出范围。

我可以帮助您更改代码二，以便正确过滤列。

Code One

Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long

With Worksheets("Okay")

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
        If .Cells(i, "A").Value = "Welcome" Then
            iTarget = iTarget + 1
            .Cells(i, "B").Copy
            Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "C").Copy
            Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "D").Copy
            Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "E").Copy
            Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "F").Copy
            Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
            Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "How"
            Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "Are"
            Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "You"
            Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "Okay"
            .Cells(i, "N").Copy
            Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "O").Copy
            Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "P").Copy
            Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "Q").Copy
            Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "R").Copy
            Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
        End If
    Next i

End With

Code Two

Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long

With Worksheets("Okay")

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
        If .Cells(i, "A").Value = "Welcome" Then
        If .Cells(i, "N").Value <> "" Then
        If .Cells(i, "O").Value <> "" Then
        If .Cells(i, "P").Value <> "" Then
        If .Cells(i, "Q").Value <> "" Then
        If .Cells(i, "R").Value <> "" Then
            iTarget = iTarget + 1
            .Cells(i, "B").Copy
            Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "C").Copy
            Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "D").Copy
            Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "E").Copy
            Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "F").Copy
            Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
            Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "Hello"
            Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "How"
            Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "Are"
            Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "You"
            .Cells(i, "N").Copy
            Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "O").Copy
            Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "P").Copy
            Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "Q").Copy
            Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "R").Copy
            Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "G").Copy
            Worksheets("Sheet7").Range("P" & iTarget + 1).PasteSpecial xlPasteValues
        End If
        End If
        End If
        End If
        End If
        End If
    Next i

End With

Answer 1

如果你得到一个＆＃34;下标超出范围＆＃34;行上的错误

Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues

然后最可能的原因（或者，我认为，唯一的原因）是你没有一个名为＆＃34; Sheet7＆＃34;的工作表。

注意：您可以通过不使用复制/粘贴来改进代码。复制/粘贴速度很慢，如果用户在等待宏运行时在其他某个应用程序中执行另一个手动复制/粘贴，也会导致问题。试试这个稍微重构过的代码：

Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long
iTarget = 1 ' initialise value to avoid lots of "+ 1"s

With Worksheets("Okay")    
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
        If .Cells(i, "A").Value = "Welcome" Then
        If .Cells(i, "N").Value <> "" Then
        If .Cells(i, "O").Value <> "" Then
        If .Cells(i, "P").Value <> "" Then
        If .Cells(i, "Q").Value <> "" Then
        If .Cells(i, "R").Value <> "" Then
            iTarget = iTarget + 1
            'Set 4 columns at once
            Worksheets("Sheet7").Range("A" & iTarget).Resize(1, 4).Value = .Cells(i, "B").Resize(1, 4).Value
            Worksheets("Sheet7").Range("F" & iTarget).Value = .Cells(i, "F").Value
            Worksheets("Sheet7").Range("G" & iTarget).Value = "Hello"
            Worksheets("Sheet7").Range("H" & iTarget).Value = "How"
            Worksheets("Sheet7").Range("I" & iTarget).Value = "Are"
            Worksheets("Sheet7").Range("J" & iTarget).Value = "You"
            'Set 5 columns at once
            Worksheets("Sheet7").Range("K" & iTarget).Resize(1, 5).Value = .Cells(i, "N").Resize(1, 5).Value
            Worksheets("Sheet7").Range("P" & iTarget).Value = .Cells(i, "G").Value
        End If
        End If
        End If
        End If
        End If
        End If
    Next i    
End With

仅当选定列中的单元格不为空时才复制行

1 个答案: