Удаление строк со значением, повторяемым в любом месте электронной таблицы Excel - PullRequest
0 голосов
/ 03 июля 2019

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

Например, если критерии находили повторяющиеся значения в столбцах A или B

A   B   C   D   E
1   2   7   8   U
3   4   7   8   U
8   1   8   7   W
6   3   8   7   U
5   5   7   8   W

Следует удалить либо строку 1, либо 3, потому что «1» появляется в A или B, и удалить строку 2 или 4, потому что «3» появляется в A или B. Строка 5 не должна быть удалена, потому что «5» появляется и в A и B. Я ожидаю, что это будет выглядеть так:

A   B   C   D   E
1   2   7   8   U
6   3   8   7   U
5   5   7   8   W

Буду признателен за любую помощь. Большое спасибо

Ответы [ 2 ]

0 голосов
/ 04 июля 2019

Вам не нужен VBA.Это можно сделать с помощью Advanced Filter, используя критерии формулы.

Таблице данных требуется строка заголовка

Критерии формулы:

A2:  =SUMPRODUCT(--(A10=Sheet1!$B$10:$B$14))=0
A3:  =A10=B10

До

enter image description here

Диалог

enter image description here

После

enter image description here

Если вы не хотите выполнять фильтрацию на месте, есть опция для вывода вотдельный диапазон в диалоге.

Если бы я собирался использовать решение VBA, я бы, вероятно, использовал бы словарь для сбора интересующих строк, а затем плюнул бы их на диапазон результатов / лист

Это один из способов сделать это.

За счет более сложного кодирования этот алгоритм можно значительно ускорить, используя в коде массивы VBA.Но я выбрал более простой путь для демонстрации.Я бы использовал более сложный метод, только если этот метод окажется слишком медленным.

Этот алгоритм предполагает, что исходная таблица начинается в A9, но вы можете легко это изменить.

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

Option Explicit
Sub filterMatchesAB()
    Dim rSrc As Range, C As Range, rRes As Range
    Dim wsSrc As Worksheet, wsRes As Worksheet
    Dim myDict As Object, myKey As Variant
    Dim I As Long

Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

With wsSrc
    Set rSrc = .Range(.Cells(9, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=5)
End With

Set myDict = CreateObject("Scripting.Dictionary")
For Each C In rSrc.Rows
    myKey = C.Cells(1, 1)
    If Not myDict.exists(C.Cells(1, 2).Value) Then
        myDict.Add Key:=myKey, Item:=C
    End If
Next C

Application.ScreenUpdating = False
I = 0
For Each myKey In myDict.keys
    I = I + 1
    myDict(myKey).Copy rRes(I, 1)
Next myKey

End Sub
0 голосов
/ 04 июля 2019
Sub Macro1()

Dim rngA As Range, rngB As Range, LastRow As Long, i As Long, x As Variant

With ThisWorkbook.Worksheets(1)
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set rngA = .Range("A1:A" & LastRow)
    Set rngB = .Range("B1:B" & LastRow) 'assuming both columns have same number of rows
End With

For i = LastRow To 1 Step -1
    x = Application.Match(rngA(i), rngB, 0)
    If Not IsError(x) Then
        If x <> i Then rngA(i).EntireRow.Delete
    End If
Next i

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