2개의 열에서 일치하지 않는 숫자를 새 시트로 가져와야 합니다.

Question

나는 배심원단에서 "열 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초목록을 생성합니다.

경고 100,000개 행에 대해 220,000개 행 검사를 시도했습니다. 그리고 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분 이내에 220,000 x 220,000개의 항목을 관리했습니다.

편집 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

Answer 1