Как запускать макрос только в тех строках, в которых макрос еще не работал - PullRequest
0 голосов
/ 03 февраля 2020

В настоящее время у меня есть несколько листов, которые копируют строки с листа «Master» на основе условия текста, найденного в столбце B. Я создал кнопку на листе «Master» для запуска следующего на каждом листе, который также будет скопирован .

Если «Мастер» обновляется ежемесячно, как предотвратить повторное копирование строк, уже скопированных на лист «KA CC», при запуске макроса?

Sub CopyRowsAcross()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Master")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("KACC")

For i = 2 To ws1.Range("B65536").End(xlUp).Row
    If ws1.Cells(i, 2) = "Kimborough Ambulatory Care Center" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
Next i
End Sub

1 Ответ

0 голосов
/ 03 февраля 2020

Эта пользовательская функция должна работать, чтобы увидеть, соответствует ли одна строка диапазону строк, проходя по каждому столбцу. Если они совпадают, будет возвращено True или False, если что-то отличается.

Обратите внимание, что количество столбцов должно быть одинаковым, поэтому, вероятно, лучше всего включать всю строку. Функция учитывает конечные диапазоны, поэтому она не должна слишком сильно влиять на производительность.

Exit Function означает, по сути, отсутствие совпадения (False).

Возможно, есть некоторые условия я Я не думаю о (я учел пробелы), но, надеюсь, вы поняли идею. Если у кого-то есть более оптимальный подход, мне было бы интересно посмотреть.

Function checkifRowexists(rowToCheck As Range, RngToCheck) As Boolean

Dim c As Long

If rowToCheck.Columns.Count = RngToCheck.Columns.Count Then

    For c = 1 To rowToCheck.Columns.Count

      If VBA.IsError(Application.Match(rowToCheck.Cells(1, c).Value, RngToCheck.Columns(c), 0)) Then

        If IsEmpty(rowToCheck.Cells(1, c)) Then
            If Application.WorksheetFunction.CountBlank(RngToCheck.Columns(c)) = 0 Then
                Exit Function
            End If
        Else

            Exit Function
        End If

     End If

    If Intersect(rowToCheck.Worksheet.UsedRange, rowToCheck.Cells(1, c)) Is Nothing And _
       Intersect(RngToCheck.Worksheet.UsedRange, RngToCheck.Columns(c)) Is Nothing Then
       Exit For
    End If


    Next c

    checkifRowexists = True
End If

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