Как удалить повторяющиеся строки в нескольких столбцах без лишних циклов? - PullRequest
0 голосов
/ 13 марта 2019

Большинство вопросов сосредоточены на дубликатах одного столбца, которые проще и менее сложны в вычислительном отношении.

Я создал скрипт, который будет удалять дублирующиеся строки в нескольких столбцах - это означает, что все столбцы имеют одинаковые значения с другимстрока, то это повторяющаяся строка и должна быть удалена.Проблема в том, что он слишком неэффективен из-за вложенных циклов for-next.Если в рабочей книге 1200 строк и 7 столбцов, будет 1200 x 1200 x 7 прогонов, что будет равно примерно 10 миллионам прогонов.Я знаю, что массивы будут быстрее, но я больше обеспокоен тем, как найти способ уменьшить количество циклов.

Код показан ниже:

Option Explicit
Function RemoveNonTableDuplicate()
Dim Range_scanned As Range, Range_compared As Range, i As Long, j As Long, x As Long, z As Long, Match As Long, Sheet_name As String, Workbook_name As String, Total_rows As Long

Workbook_name = InputBox("Please Input the Workbook Name", "Identify Workbook Name")
Sheet_name = InputBox("Please Input the Worksheet Name", "Identify Worksheet Name")

Start:
Total_rows = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Total_rows
    Match = 0
    Set Range_scanned = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & i & ":E" & i)
    For j = 2 To Total_rows
        Set Range_compared = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & j & ":E" & j)
        For z = 1 To TotalColumnsCount(Workbooks(Workbook_name).Name, Sheet_name)
            If Range_scanned(z) = Range_compared(z) Then
                x = x + 1
            End If
        Next z
        If x = TotalColumnsCount(Workbooks(Workbook_name).Name, Sheet_name) Then
            Match = Match + 1
        End If
        x = 0
        If Match > 1 Then
            Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & j & ":E" & j).Delete Shift:=xlUp
            GoTo Start
        End If
    Next j
Next i
End Function

Чтобы проиллюстрировать, как должен работать код, обратитесь к изображениям ниже.

Перед запуском кода:

Prior

После запуска кода для удаления дубликатов:

After

1 Ответ

5 голосов
/ 13 марта 2019

Что мешает вам использовать это?

Range("A:E").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...