Как скопировать только те строки данных, которые еще не были скопированы в другую книгу? - PullRequest
0 голосов
/ 11 июня 2019

Мне нужно найти определенные строки в моей электронной таблице, и, если найдено, скопировать всю строку данных, где они были найдены, в другую рабочую книгу - эта часть работает нормально. VBA - это не тот язык, с которым мне комфортно, и я унаследовал этот код как отправную точку. Моя главная проблема заключается в том, что он еще не проверяет, был ли этот ряд данных скопирован в другую книгу ранее копирование. Таким образом, каждый раз, когда он запускается (при сохранении), он снова копирует все строки соответствия критериям.

'Search code
LastRow = Alpha.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Loop search code
For i = 2 To LastRow

   'Compare columns for mismatches
    If Alpha.Range("F" & i) <> Alpha.Range("G" & i) Then

   'Pull out mismatches if contain specific text
    Select Case True
       'Search for specific text
        Case (InStr(1, Alpha.Range("G" & i), "ABC") > 0)
       'Move mismatched row to next empty row in TrackSheet
            NextRow = TrackSheet.Rows(Rows.Count).End(xlUp).Row + 1
            Alpha.Rows(i).Copy
            TrackSheet.Rows(NextRow).PasteSpecial (xlPasteValues)
    End Select
    End If

Next i

Любая помощь будет очень ценится !!! Я искал форумы весь день и не достаточно хорошо разбираюсь в VBA, чтобы адаптировать какие-либо решения для своего собственного кода.

1 Ответ

0 голосов
/ 11 июня 2019

Предполагая, что оба листа имеют уникальный идентификатор в ColA, вы можете использовать Match для проверки существующей строки:

Dim CoderBook As Workbook
Dim CDIreview As Workbook
Dim Ophth As Worksheet
Dim VERA As Worksheet
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long, m

'Search code
LastRow = Ophth.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious).Row

'Loop search code
For i = 2 To LastRow

   'Compare columns for mismatch
    If Ophth.Range("F" & i) <> Ophth.Range("G" & i) Then

   'Pull out specific high priority mismatches
    Select Case True
       'Search strings in column H for high priority mismatches
        Case (InStr(1, Ophth.Range("G" & i), "H54") > 0)
            'Move mismatched row to next empty row in CoderBook/VERA sheet

            'look for Id match in destination sheet
            m = Application.Match(Ophth.Range("A" & i).Value, VERA.Columns(1), 0)
            If IsError(m) Then
                'no match on Id - copy values
                VERA.Cells(Rows.Count,1).End(xlUp).Offset(1,0).EntireRow.Value = _
                                                               Ophth.Rows(i).Value
            End If

    End Select
    End If

Next i
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...