'중복개수 VBA'에 해당되는 글 1건

중복개수 표시 VBA

중복개수가 3이면 전부 3으로 표시하고 싶을 때 사용하는 VBA 코드 입니다.

중복개수를 구할 때는 가급적이면 중복개수 구할 필드를 Sorting(정렬) 해두면 빠릅니다.

엑셀에서 기본 제공하는 CountIF 함수를 VBA 에서 이용하고자 한다면 Applicaton.CountIF 처럼 앞에 Application 을 붙여주면 됩니다.

내가 잘 알고 있는 엑셀함수를 이용하고자 할 때에는 이렇게 사용하면 됩니다.

엑셀로 작업을 하다보면 중복개수를 전부다 표시를 해두면 유용한 경우가 있고, 중복을 카운트로 증가시키면 유용한 경우가 있습니다.

그런데 이 함수는 엑셀에서도 범위지정이 크면 메모리 에러가 발생하고, VBA 에서도 심한 지연현상이 발생하더군요. 제가 테스트한 범위는 30만개 데이터였습니다. 

Sub 중복개수표시()

    Dim rngC As Range

    Dim rngAll As Range

    Application.ScreenUpdating = False   '// 화면 업데이트 (일시) 중지

    rngCh = "A"                          '// 열지정

    StartRow = 2                      '// 데이터 시작행 설정

    Set rngAll = Range(Cells(StartRow, rngCh), Cells(Rows.Count, rngCh).End(3))  '// 범위지정

    For Each rngC In rngAll

        rngC.Offset(0, 1) = Application.CountIf(rngAll, rngC)

        '// 동일한 경우만큼 모두 숫자를 표시

    Next rngC

    Set rngAll = Nothing

    MsgBox "완료"

End Sub

먼저 Sorting 을 한다음에 데이터를 좀 잘게 잘라서 for 문으로 돌려가면서 처리하는게 방법이지 않을까 싶더군요. 그래서 중복개수 표시수를 증가하면서 표시되게 하는 VBA 코드를 만들어봤습니다.

SplitLine 은 500 정도될 때 속도가 가장 빠르던데 PC 환경마다 조금씩 다를 거라 봅니다.

고수분께서 잘못된 것이 있으면 지적해주시면 감사하겠구요.

Sub 중복개수표시()

    Dim rngDB As Range

    Dim i, n As Double

    Dim SplitLine, startRow, LastRow As Double  '// Integer 로 지정하면 버퍼오버플로우가 날 수 있다.

    startRow = InputBox("시작행을 입력하세요")

    If startRow = "" Then Exit Sub              '// 입력값이 없으면 매크로 중단

    If Not IsNumeric(startRow) Then Exit Sub     '// 숫자가 아니면 매크로 중단

    SplitLine = 3000

    For n = 1 To (Cells(Rows.Count, "D").End(3).Row \ SplitLine) + 1

        If (SplitLine + startRow) > Cells(Rows.Count, "D").End(3).Row Then

            LastRow = Cells(Rows.Count, "D").End(3).Row     '// 마지막 행이 SplitLine 보다 작으면

        Else

            LastRow = SplitLine + startRow                  '// 마지막 행이 SplitLine 보다 크면

        End If

        Set rngDB = Range(Cells(startRow, "D"), Cells(LastRow, "D"))

        For i = startRow To LastRow     '// SplitLine 만큼 반복 수행하라

            Cells(i, "E") = Application.CountIf(rngDB, Cells(i, "D"))

        Next i

        Cells(i - 1, "Q") = 1  '// for 문 종료 다음 셀을 찾기 쉽게 반복된 구간마다 1을 마킹하라

        Set rngDB = Nothing    '// 메모리 비우기 

        Do Until (Cells(i, "D") <> Cells(i - 1, "D"))   '// 조건이 충족될 때까지 처리를 반복하라

            i = i - 1

        Loop            '// 조건이 충족되면 Loop 다음으로 이동하라

        startRow = i    '// Do Until 문으로 셀이 서로 다른 행까지 찾은 값을 시작행으로 지정

       If Cells(Rows.Count, "D").End(3).Row <= LastRow Then Exit For    '// LastRow 보다 작으면 For 문을 종료

        'Application.Wait Now() + TimeValue("00:00:02")  '// 메모리 비우는 작업을 수행??

    Next n

    MsgBox "완료"

End Sub

약간씩 타이머로 대기를 하는 경우에도 약간 더 시간이 걸리기는 하지만 결과는 잘 나오더군요.

        Do Until (Cells(i, "D") <> Cells(i - 1, "D"))   '// 조건이 충족될 때까지 처리를 반복하라

            i = i - 1

        Loop            '// 조건이 충족되면 Loop 다음으로 이동하라