'VBA 중복 연속값 구하기'에 해당되는 글 1건

[VBA] 연속되는 값의 증가 최대값 모두 구하기

바로 이전 게시물을 버전업하여 작성한 것입니다.

VBA 고수분의 자료를 참조하여 응용하고 재 작성한 것입니다.

자료의 양이 방대할 경우에는 모든 값을 다 구해야 하는 거 아닌가 싶기도 해서 다시 구현해 봤습니다.

가령 구하는 값의 종류가 10개 라고 할 때에도 자동으로 10개의 값에 해당하는 증가 최대값을 모두 자동으로 구하는 식입니다.

Option Explicit

Sub MAX_Duplicate_Cnt()
    Dim rngCh, rngT           '// 입력할 열 글자
    Dim i As Integer   '// 한 셀씩 변하는 변수 지정
    Dim endRow As Integer   '// 최대 Row 수 구하는 변수 지정
    Dim cnt, Max_Cnt As Integer
    Dim oldTime As Single   '// 걸린 시간 구하는 변수 지정
    Dim rngAll As Range     '// D열의 모든 문자를 넣을 변수
    Dim rngC As Range       '// D열의 각셀을 넣을 변수
   
    oldTime = Timer     '// 시간 변수 설정, 필요없으면 콤마(,)로 disable
    Application.ScreenUpdating = False              '화면 업데이트 (일시)정지
   
    rngCh = "A"         '// 검사할 열
    endRow = Cells(Rows.Count, rngCh).End(3).Row
    rngT = "B"          '// 결과를 뿌려줄 열
    cnt = 1             '// 초기 카운트
    Max_Cnt = 1         '// 최대값 구하는 초기값

    '------------------- 연속되는 값 증가 구하는 함수식 --------------------------
    For i = 1 To endRow - 1
        If Cells(i, rngCh).Value = Cells(i + 1, rngCh).Value Then
            Cells(i + 1, rngT).Value = cnt + Cells(i, rngT).Value
        Else
            Cells(i + 1, rngT).Value = 1
        End If
        Cells(i, 4).Value = Cells(i, rngCh).Value   '// A열을 D열에 모두 복사 숫자4는 D열을 의미
    Next i
   
    '------------------- D열의 중복값 모두 제거 및 오름차순 정렬 ----------------------
    Set rngAll = Range("D2", Cells(Rows.Count, "D").End(3))  'D열 데이터영역을 변수에
    For Each rngC In rngAll                               'A열 각셀을 순환
        cnt = WorksheetFunction.CountIf(rngAll, rngC)   '각셀의 countif 값을 변수에
        If cnt > 1 Then                                        '만약 같은 이름이 1개 이상이면
            rngC.Resize(, 1).ClearContents            '그 열의 데이터를 삭제
        End If
     Next rngC

    Range([D2], Cells(Rows.Count, "D").End(3)).Sort key1:=Range("D2"), order1:=xlAscending  '오름차순 정렬
   
    '--------------------- 값의 변수 전체에 대한 연속 최대값 구하기 ----------------------
    Columns("E:E").EntireColumn.ClearContents   '// 값을 산출할 열 전체를 초기화
    For Each rngC In rngAll
        For i = 1 To endRow - 1
            If rngC.Value = Cells(i, rngCh) Then
                If Max_Cnt <= Cells(i + 1, rngT).Value Then     '// 최대값 구하는 조건
                   Max_Cnt = Cells(i + 1, rngT).Value
                   rngC.Offset(0, 1).Value = Max_Cnt
                   rngC.Offset(0, 1).HorizontalAlignment = xlCenter '// 가운데 정렬
                   rngC.HorizontalAlignment = xlCenter
                End If
            End If
        Next i
        Max_Cnt = 1     '// 최대값 초기화
    Next rngC
   
    Set rngAll = Nothing     '개체변수 초기화(메모리 비우기)
    Set rngC = Nothing
 
    'MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"

End Sub

첨부한 파일을 엑셀파일에서 활용하면 됩니다.

원하는 형태로 약간 수정해서 사용하면 됩니다.

연속중복값계산.vbs