☰

2つの列のExcelから一致しない数字を新しいシートに抽出する必要があります

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010
2つの列のExcelから一致しない数字を新しいシートに抽出する必要があります

列ごとに 2 つの大きな列 (139456 件のレコード) があります。一致しないレコードを新しいシート「コール シート」に抽出する必要があります。時間の経過とともに、両方のリストの下部に追加していきます。一致しないレコードを「コール シート」の下部に追加したいと思います。ほぼ完了しましたが、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」からすべてのデータを取り除きました。しない「列 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

あまり速くはありませんが、少なくともエラーは発生しません。列1に45000エントリ、列2に400エントリで試したところ、約6秒リストを生成します。

警告 22 万行を 10 万行に対してチェックしてみました。そして 15 分後もまだ実行中です。ですから、これを使用したい場合は、一度だけ実行すればいいと思います。

自動化することもできますが、その場合は、より高速な方法、または最後に追加された値のみを確認する方法が必要になるでしょう。
また、これを 2 回実行すると、すべてが 2 回追加されるだけであることに注意してください。最初にリストをクリアしません。

編集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") を 2 つの新しい列にコピーします。元のリストが台無しにならないようにするためです。
次に、最初のコピーをテーブルにして、2 番目の範囲 (列 "B") でフィルターします。
次に、テーブル内のすべての表示セルの内容をクリアして、テーブルを削除します。これで、
最初のコピーには必要なデータのみがあり、不要なデータがすべてクリアされた穴がたくさんあります。そこで、その範囲を新しいフィルターにします。
これで、2 番目のコピーがテーブルになり、新しいフィルターで並べ替えられます。
次に、表示セル (必要なデータ) が別の列にコピーされます。

現在、コードはすべてを同じシート上で実行します。そして、列を占有します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

関連情報