使用 Instr 复制整行

Question

嗨，我想遍历我的传播中的每一行sheet，并且对于每个实例，它都会找到单词 "North East" 以将该行复制到东北部 sheet。这将每周重复一次，因此我需要脚本来检查该条目是否已存在于东北 sheet 中，如果它什么都不做并移至下一行。我不确定如何执行此操作，因为我是 vba 新手。任何帮助，将不胜感激。

谢谢

Sub Contain_Copy()
Dim ranger As Long
Dim lastrow As Long
Dim FromSheet As Worksheet, ToSheet As Worksheet

Set FromSheet = Sheets("Master")
Set ToSheet = Sheets("NE")
lastrow = FromSheet.Cells(Rows.Count, "G").End(xlUp).Row

For ranger = 2 To lastrow
    If InStr(1, FromSheet.Cells(ranger, "G"), "North East") > 0 Then
        FromSheet.Cells(ranger, "G").EntireRow.Copy _
        Destination:=ToSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next ranger
End Sub

Answer 1

您可以在 ToSheet 列 "A" 上使用 Find() 来检查当前 FromSheet 列 A 单元格值：

Option Explicit

Sub Contain_Copy()
    Dim ranger As Long
    Dim lastrow As Long
    Dim FromSheet As Worksheet, ToSheet As Worksheet

    Set FromSheet = Sheets("Master")
    Set ToSheet = Sheets("NE")
    lastrow = FromSheet.Cells(Rows.Count, "G").End(xlUp).Row

    For ranger = 2 To lastrow
        If InStr(1, FromSheet.Cells(ranger, "G"), "North East") > 0 Then
            If Intersect(ToSheet.UsedRange, ToSheet.Columns(1)).Find(what:=FromSheet.Cells(ranger, "A").Value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then _
                FromSheet.Cells(ranger, "G").EntireRow.Copy Destination:=ToSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next ranger
End Sub

您还可以使用 With ... End With 阻止并减少对 FromSheet 对象的访问

Sub Contain_Copy()
    Dim ranger As Long
    Dim ToSheet As Worksheet

    Set ToSheet = Sheets("NE")

    With Sheets("Master") ' reference "Master" sheet
        For ranger = 2 To .Cells(.Rows.Count, "G").End(xlUp).Row
            If InStr(1, .Cells(ranger, "G"), "North East") > 0 Then
                If Intersect(ToSheet.UsedRange, ToSheet.Columns(1)).Find(what:=.Cells(ranger, "A").Value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then _
                    .Cells(ranger, "G").EntireRow.Copy Destination:=ToSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        Next ranger
    End With
End Sub

Answer 2

这是一种方法（尽管 CLR 可以说效率更高）首先使用 Match 检查列 A 值是否已经存在于 NE sheet.

的列 A 中

Sub Contain_Copy()

Dim ranger As Long
Dim lastrow As Long
Dim FromSheet As Worksheet, ToSheet As Worksheet, v As Variant

Set FromSheet = Sheets("Master")
Set ToSheet = Sheets("NE")
lastrow = FromSheet.Cells(Rows.Count, "G").End(xlUp).Row

For ranger = 2 To lastrow
    If InStr(1, FromSheet.Cells(ranger, "G"), "North East") > 0 Then
        v = Application.Match(FromSheet.Cells(ranger, "A"), ToSheet.Columns(1), 0)
        If IsError(v) Then
            FromSheet.Cells(ranger, "G").EntireRow.Copy _
            Destination:=ToSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    End If
Next ranger

End Sub

使用 Instr 复制整行

Copying entire row using Instr

excel

vba

copy-paste