programing

두 열의 빠른 비교 방법

javamemo 2023. 8. 18. 20:39
반응형

두 열의 빠른 비교 방법

편집: 내 솔루션 대신 다음과 같은 것을 사용합니다.

 For i = 1 To tmpRngSrcMax
     If rngSrc(i) <> rngDes(i) Then ...
 Next i

그것은 약 100배 더 빠릅니다.

나는 VBA를 사용하여 문자열 데이터가 포함된 두 개의 열을 비교해야 합니다.제 접근 방식은 다음과 같습니다.

Set rngDes = wsDes.Range("A2:A" & wsDes.Cells(Rows.Count, 1).End(xlUp).Row)
Set rngSrc = wsSrc.Range("I3:I" & wsSrc.Cells(Rows.Count, 1).End(xlUp).Row)

tmpRngSrcMax = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
cntNewItems = 0

For Each x In rngSrc

tmpFound = Application.WorksheetFunction.CountIf(rngDes, x.Row)
Application.StatusBar = "Processed: " & x.Row & " of " & tmpRngSrcMax & " / " & Format(x.Row / tmpRngSrcMax, "Percent")
DoEvents ' keeps Excel away from the "Not responding" state

If tmpFound = 0 Then ' new item
    cntNewItems = cntNewItems + 1

    tmpLastRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row + 1  ' first empty row on target sheet
    wsDes.Cells(tmpLastRow, 1) = wsSrc.Cells(x.Row, 9)
End If
Next x

따라서 각 루프를 사용하여 첫 번째(src) 열에서 반복하고 CountIf 방법을 사용하여 항목이 두 번째(des) 열에 이미 있는지 확인합니다.그렇지 않은 경우 첫 번째(src) 열의 끝으로 복사합니다.

코드는 작동하지만, 제 컴퓨터에서는 약 7000개의 행이 있는 열이 주어진 경우 200초가 소요됩니다.저는 CountIf가 공식으로 직접 사용할 때 훨씬 더 빨리 작동한다는 것을 알게 되었습니다.

코드 최적화에 대한 아이디어를 가진 사람이 있습니까?

좋아요. 몇 가지만 분명히 해두죠.

소 열A가지다10,000랜덤하게 생성된 값, 열I가지다5000임의로 생성된 값입니다.이렇게 생겼어요.

enter image description here

10,000개의 세포에 대해 3개의 다른 코드를 실행했습니다.

당신이 제안하는 접근법.

Sub ForLoop()

Application.ScreenUpdating = False

    Dim stNow As Date
    stNow = Now

    Dim lastA As Long
    lastA = Range("A" & Rows.Count).End(xlUp).Row

    Dim lastB As Long
    lastB = Range("I" & Rows.Count).End(xlUp).Row

    Dim match As Boolean

    Dim i As Long, j As Long
    Dim r1 As Range, r2 As Range
    For i = 2 To lastA
        Set r1 = Range("A" & i)
        match = False
        For j = 3 To lastB
            Set r2 = Range("I" & j)
            If r1 = r2 Then
                match = True
            End If
        Next j
        If Not match Then
            Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = r1
        End If
    Next i

    Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

시드의 감정사

Sub Sample()
    Dim wsDes As Worksheet, wsSrc As Worksheet
    Dim rngDes As Range, rngSrc As Range
    Dim DesLRow As Long, SrcLRow As Long
    Dim i As Long, j As Long, n As Long
    Dim DesArray, SrcArray, TempAr() As String
    Dim boolFound As Boolean

    Set wsDes = ThisWorkbook.Sheets("Sheet1")
    Set wsSrc = ThisWorkbook.Sheets("Sheet2")

    DesLRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row
    SrcLRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row

    Set rngDes = wsDes.Range("A2:A" & DesLRow)
    Set rngSrc = wsSrc.Range("I3:I" & SrcLRow)

    DesArray = rngDes.Value
    SrcArray = rngSrc.Value

    For i = LBound(SrcArray) To UBound(SrcArray)
        For j = LBound(DesArray) To UBound(DesArray)
            If SrcArray(i, 1) = DesArray(j, 1) Then
                boolFound = True
                Exit For
            End If
        Next j

        If boolFound = False Then
            ReDim Preserve TempAr(n)
            TempAr(n) = SrcArray(i, 1)
            n = n + 1
        Else
            boolFound = False
        End If
    Next i

    wsDes.Cells(DesLRow + 1, 1).Resize(UBound(TempAr) + 1, 1).Value = _
    Application.Transpose(TempAr)
End Sub

나의 (방법) 접근법

Sub Main()
Application.ScreenUpdating = False

    Dim stNow As Date
    stNow = Now

    Dim arr As Variant
    arr = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Value

    Dim varr As Variant
    varr = Range("I3:I" & Range("I" & Rows.Count).End(xlUp).Row).Value

    Dim x, y, match As Boolean
    For Each x In arr
        match = False
        For Each y In varr
            If x = y Then match = True
        Next y
        If Not match Then
            Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = x
        End If
    Next

    Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

다음과 같은 결과

enter image description here

이제, 당신은 빠른 비교 방법을 선택합니다 :)

임의 값 채우기

Sub FillRandom()
    Cells.ClearContents
    Range("A1") = "Column A"
    Range("I2") = "Column I"

    Dim i As Long
    For i = 2 To 10002
        Range("A" & i) = Int((10002 - 2 + 1) * Rnd + 2)
        If i < 5000 Then
            Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = _ 
                 Int((10002 - 2 + 1) * Rnd + 2)
        End If
    Next i

End Sub

위의 예에 대해 mehow에서 거의 즉시 실행되는 비루프 코드가 있습니다.

Sub HTH()

    Application.ScreenUpdating = False

    With Range("A2", Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
        .Formula = "=VLOOKUP(A2,I:I,1,FALSE)"
        .Value = .Value
        .SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Range("I" & Rows.Count).End(xlUp).Offset(1)
        .ClearContents
    End With

    Application.ScreenUpdating = True

End Sub

원하는 열을 더미 열로 사용할 수 있습니다.

정보: 루프에 휘말리는 것을 완료했습니다.

속도 테스트 관련 참고 사항:
테스트를 실행하기 전에 vba 프로젝트를 컴파일합니다.
각 루프의 경우 i용 = 1 ~ 10개 루프보다 더 빨리 실행됩니다.
가능한 경우 Exit For를 사용하여 의미 없는 루프를 방지할 수 있는 답이 발견되면 루프를 종료합니다.
길이가 정수보다 빨리 실행됩니다.

마지막으로 더 빠른 루프 방법(루프해야 하지만 여전히 위의 비루프 방법보다 빠르지 않은 경우):

Sub Looping()
    Dim vLookup As Variant, vData As Variant, vOutput As Variant
    Dim x, y
    Dim nCount As Long
    Dim bMatch As Boolean

    Application.ScreenUpdating = False

    vData = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
    vLookup = Range("I2", Cells(Rows.Count, "I").End(xlUp)).Value

    ReDim vOutput(UBound(vData, 1), 0)

    For Each x In vData
        bMatch = False
        For Each y In vLookup
            If x = y Then
                bMatch = True: Exit For
            End If
        Next y
        If Not bMatch Then
            nCount = nCount + 1: vOutput(nCount, 0) = x
        End If
    Next x

    Range("I" & Rows.Count).End(xlUp).Offset(1).Resize(nCount).Value = vOutput

    Application.ScreenUpdating = True      

End Sub

@brettdj 코멘트에 따라 For Next 대안:

For x = 1 To UBound(vData, 1)
    bMatch = False
    For y = 1 To UBound(vLookup, 1)
        If vData(x, 1) = vLookup(y, 1) Then
            bMatch = True: Exit For
        End If
    Next y
    If Not bMatch Then
        nCount = nCount + 1: vOutput(nCount, 0) = vData(x, 1)
    End If
Next x

을 이용하면,값을 .value 대신 2로 지정하면 다시 조금 더 빨라집니다.

그냥 이걸 빨리 썼을 뿐...이것 좀 테스트해 주시겠어요?

Sub Sample()
    Dim wsDes As Worksheet, wsSrc As Worksheet
    Dim rngDes As Range, rngSrc As Range
    Dim DesLRow As Long, SrcLRow As Long
    Dim i As Long, j As Long, n As Long
    Dim DesArray, SrcArray, TempAr() As String
    Dim boolFound As Boolean

    Set wsDes = ThisWorkbook.Sheets("Sheet1")
    Set wsSrc = ThisWorkbook.Sheets("Sheet2")

    DesLRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row
    SrcLRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row

    Set rngDes = wsDes.Range("A2:A" & DesLRow)
    Set rngSrc = wsSrc.Range("I3:I" & SrcLRow)

    DesArray = rngDes.Value
    SrcArray = rngSrc.Value

    For i = LBound(SrcArray) To UBound(SrcArray)
        For j = LBound(DesArray) To UBound(DesArray)
            If SrcArray(i, 1) = DesArray(j, 1) Then
                boolFound = True
                Exit For
            End If
        Next j

        If boolFound = False Then
            ReDim Preserve TempAr(n)
            TempAr(n) = SrcArray(i, 1)
            n = n + 1
        Else
            boolFound = False
        End If
    Next i

    wsDes.Cells(DesLRow + 1, 1).Resize(UBound(TempAr) + 1, 1).Value = _
    Application.Transpose(TempAr)
End Sub

방금 두 목록에서 누락된 항목을 가져오도록 Mehow를 수정했습니다.누군가가 그것을 필요로 할지도 모르니까요.코드 공유 감사합니다.

Sub Main()

Application.ScreenUpdating = False

Dim stNow As Date
stNow = Now

Dim varr As Variant
varr = Range("A2:A" & Range("A" & Rows.count).End(xlUp).row).Value

Dim arr As Variant
arr = Range("I3:I" & Range("I" & Rows.count).End(xlUp).row).Value

Dim x, y, match As Boolean
For Each y In arr
    match = False
    For Each x In varr
        If y = x Then match = True
    Next x
    If Not match Then

        Range("B" & Range("B" & Rows.count).End(xlUp).row + 1) = y

    End If
Next
Range("B1") = "Items not in A Lists"
Range("B" & Range("B" & Rows.count).End(xlUp).row + 1) = "Items not in I Lists"
'Dim arr As Variant
arr = Range("A3:A" & Range("A" & Rows.count).End(xlUp).row).Value

'Dim varr As Variant
varr = Range("I3:I" & Range("I" & Rows.count).End(xlUp).row).Value

'Dim x, y, match As Boolean
For Each x In arr
    match = False
    For Each y In varr
        If x = y Then match = True
    Next y
    If Not match Then
        Range("B" & Range("B" & Rows.count).End(xlUp).row + 1) = x
    End If
Next


Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True

End Sub

Function Ranges_Iguais(rgR1 As Range, rgR2 As Range) As Boolean

  Dim vRg1 As Variant
  Dim vRg2 As Variant
  Dim i As Integer, j As Integer

  vRg1 = rgR1.Value
  vRg2 = rgR2.Value
  i = 0

  Do
    i = i + 1
    j = 0
    Do
        j = j + 1
    Loop Until vRg1(i, j) <> vRg2(i, j) Or j = UBound(vRg1, 2)
  Loop Until vRg1(i, j) <> vRg2(i, j) Or i = UBound(vRg1, 1)

  Ranges_Iguais = (vRg1(i, j) = vRg2(i, j))

End Function

    Set R1 = Range(S1.Cells(1, 1), S1.Cells.SpecialCells(xlCellTypeLastCell))
    Set R2 = Range(S2.Cells(1, 1), S2.Cells.SpecialCells(xlCellTypeLastCell))
    If R1.Count = R2.Count Then
        Set R3 = Range(S3.Cells(1, 1), S3.Cells(S2.Cells.SpecialCells(xlCellTypeLastCell).Row, S2.Cells.SpecialCells(xlCellTypeLastCell).Column))
        R3.Formula = "=" & R1.Address(, , , True) & "=" & R2.Address(, , , True)
        Set R = R3.Find(What:="FALSE", After:=S3.Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False)
        bComp = R Is Nothing
    Else
        bComp = False
    End If

언급URL : https://stackoverflow.com/questions/19567060/fast-compare-method-of-2-columns

반응형

'programing' 카테고리의 다른 글

PHP에서 모호하고 잘못된 날짜 시간을 탐지하는 방법은 무엇입니까?  (0) 2023.08.18
Node.js를 Maria에 연결할 수 없습니다.DB  (0) 2023.08.18
PowerShell에서 CSV로 내보낼 때 열 순서를 지정하려면 어떻게 해야 합니까?  (0) 2023.08.18
pip 설치를 사용하지 않고 tar.gz 파일에서 Python 패키지를 설치하는 방법  (0) 2023.08.18
jQuery: 동일한 이벤트에 대한 두 개 이상의 핸들러  (0) 2023.08.18

'programing'의 다른글

  • 현재글두 열의 빠른 비교 방법

관련글

댓글

티스토리툴바