☰

Мне нужно перенести несовпадающие числа из двух столбцов Excel на новый лист.

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010
Мне нужно перенести несовпадающие числа из двух столбцов Excel на новый лист.

У меня есть 2 больших столбца (139456 записей) в каждом столбце. Мне нужно извлечь несовпадающие записи в новый лист «call sheet». Я буду добавлять их в конец обоих списков со временем. Я хотел бы, чтобы он добавлял несовпадающие записи в конец «call sheet». Я почти закончил, но Excel, похоже, перегружен. Я продолжаю получать ошибку «не отвечает».

=IFERROR(INDEX($A$2:$A$1999,MATCH(0,IFERROR(MATCH($A$2:$A$1999,$B$2:$B$399,0),COUNTIF($C$1:$C1,$A$2:$A$1999)),0)),"")

Перегрузки из-за количества записей

решение1

Я немного подправил свой старый код, чтобы удалить все данные из «Столбца 1», которыйне делаетсопоставьте любые данные в "Column 2" и распечатайте их на другом листе.
Возможно, это может быть полезно для использования, вам, возможно, придется немного подправить это.

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

Sub sort()
Dim list1 As Range, list2 As Range, c As Range, outSht As Worksheet, outCol As String, Lrow As Long
'---Options---
Set list1 = Range("A2:A1999")   'Range of first column
Set list2 = Range("B2:B399")    'Range of second column
Set outSht = Sheets("Sheet2")   'Output Sheet (Create one first)
outCol = "A"                    'Output Column

Application.ScreenUpdating = False
oCN = Columns(outCol).Column
For Each c In list1
    If list2.Find(c.Value) Is Nothing Then
        lRow = outSht.Range(outCol & ActiveSheet.Rows.Count).End(xlUp).Row
        outSht.Cells(lRow + 1, oCN).Value = c.Value
    End If
Next c
Application.ScreenUpdating = True
End Sub

Это не очень быстро, но, по крайней мере, не заканчивается ошибкой. Я пробовал с 45000 записей в столбце 1 и 400 в столбце 2, и это заняло у меня около6 секунддля формирования списка.

Предупреждение Пробовал с 220 тыс. строк, проверяя против 100 тыс. строк. И через 15 минут он все еще работает. Так что да, если вы хотите использовать это, я надеюсь, вам придется запустить его только один раз.

Вы можете сделать это автоматически, но тогда вам, вероятно, понадобится более быстрый метод или тот, который смотрит только на последнее добавленное значение.
Также обратите внимание, что это просто добавит все дважды, если будет запущено дважды. Это не очищает список сначала.

ПРАВКА 2

Гораздо более быстрым способом сделать это был бы макрос, который делает это таблицей, сортирует соответствующие данные, копирует данные, а затем удаляет таблицу. Он справился со всеми 220 000 записей за считанные секунды. Мне просто нужно выяснить, как копировать вещи, НЕ соответствующие списку, а не наоборот.

Редактировать 3

Пока не разобрался с автофильтром. Но если вы не использовали этот другой код и все еще хотите, используйте вместо него это:

Sub ArrayIt()
Dim aArray As Variant, bArray As Variant
aArray = [transpose(A2:A139456)]
bArray = [transpose(B2:B139456)]
Set outSht = Sheets("Sheet2")   'Output Sheet (Create one first)
outCol = "A"                    'Output Column
Application.ScreenUpdating = False
oCN = Columns(outCol).Column
For Each c In aArray

    If IsError(Application.Match(c, bArray, 0)) Then
        Lrow = outSht.Range(outCol & outSht.Rows.Count).End(xlUp).Row
        outSht.Cells(Lrow + 1, oCN).Value = c   
    End If
Next c
Application.ScreenUpdating = True
End Sub

По сути, это то же самое, но сначала преобразует данные в массивы, а затем использует их для обработки. Это все еще медленно, но это как минимум в 20 раз быстрее, если не больше. Обработал 220k x 220k записей менее чем за 2 минуты.

Редактировать 4

Хорошо, я сделал обходной путь для автофильтра.
Проблемы:
Может толькопоказыватьзначения в моем фильтре, а не *скрыть их.
Может работать только с отображаемыми значениями.
Невозможно удалить строки с данными или без них (слишком медленно).

Решение:
Итак, вот что делает новый код:
во-первых, он копирует диапазон, с которым мы хотим работать — столбец «A» — в два новых столбца, просто чтобы убедиться, что он не испортит исходный список.
Затем он делает первую копию таблицей и фильтрует ее с помощью нашего второго диапазона — столбца «B».
Затем он очищает содержимое каждой видимой ячейки в таблице и удаляет таблицу.
Теперь первая копия — это только нужные нам данные и куча дыр, где он очистил все нежелательные данные. Так что теперь мы делаем этот диапазон нашим новым фильтром.
Теперь вторая копия становится таблицей и сортируется с помощью нового фильтра.
Затем видимые ячейки — теперь нужные нам данные — копируются в другой столбец.

В настоящее время код делает все это на одном листе. И он занимает столбец Mдо Q. Так что будьте осторожны при тестировании, так как это может все испортить, если там есть другие данные, и, вероятно, также, если на листе есть какая-то сортировка и скрытые строки.

Должен быть лучший способ написать реальный код, но это лучшее, на что я способен. Он смог запустить текущие настройки (225 000 строк данных, 100 000 параметров для фильтра) в12 секунд.

Sub aaTablefiltering()
Dim LO As ListObject, tName As String, rOne As Range, rTwo As Range, rThree As Range, rFour As Range, fArr As Variant

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Set rOne = Range("A2:A225000")
Set rTwo = Range("B2:B100000")
Set rThree = Range("M2:M225001")
Set fFour = Range("O2:O225001")
fArr = [transpose(B2:B100000)]
tName = "DTable"

rOne.Copy Destination:=Range("M2")
rOne.Copy Destination:=Range("O2")

Set LO = ActiveSheet.ListObjects.Add(xlSrcRange, rThree, , xlNo)
LO.Name = tName
ActiveSheet.ListObjects("DTable").Range.AutoFilter Field:=1, Criteria1:=fArr, Operator:=xlFilterValues
ActiveSheet.ListObjects("DTable").Range.SpecialCells(xlCellTypeVisible).ClearContents
ActiveSheet.ListObjects("DTable").Unlist
fArr = [transpose(M2:M225001)]

Set LO = ActiveSheet.ListObjects.Add(xlSrcRange, fFour, , xlNo)
LO.Name = tName
ActiveSheet.ListObjects("DTable").Range.AutoFilter Field:=1, Criteria1:=fArr, Operator:=xlFilterValues
ActiveSheet.ListObjects("DTable").Range.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=ActiveSheet.Range("Q1")
ActiveSheet.ListObjects("DTable").Unlist
Range("M:Q").ClearFormats
Range("M:O").ClearContents

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub

Связанный контент