Копирование всей строки с использованием Instr

Question

Привет, я хочу пройтись по каждой строке в моей электронной таблице, и для каждого экземпляра он находит слово «Северо-восток», чтобы скопировать эту строку в лист Северо-востока.Это будет повторяться еженедельно, и поэтому мне нужен сценарий, чтобы проверить, существует ли уже запись на северо-восточном листе, и если он ничего не делает, и перейдет к следующей строке.Я не уверен, как это сделать, так как я начинающий 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

Вот один из подходов (хотя CLR, возможно, более эффективен), использующий Match, чтобы сначала проверить, существует ли уже значение столбца A в столбце A листа NE.

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

Answer 2

вы можете использовать Find() в ToSheet столбце «A» для проверки текущего значения 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