☰

我需要将两列不匹配的数字拉到新表中

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010
我需要将两列不匹配的数字拉到新表中

每列有 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 秒生成列表。

警告 尝试用 220k 行与 100k 行进行比较。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 倍，甚至更多。在不到 2 分钟的时间内管理了 220k x 220k 个条目。

编辑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

相关内容