컴퓨터/엑셀

vba 그룹별순번매기기

풍경소리^^ 2022. 5. 4. 16:43

Sub 그룹별순번매기기()
    Dim i As Long
    Dim j As Long
    Dim lastRow As Long
    Dim currentRow As Long
    
    Application.ScreenUpdating = False
    
    If Range("B2") <> "" Then
        Range("B2", Cells(Rows.count, "B").End(xlUp)).ClearContents
    End If
    
    lastRow = Cells(Rows.count, "A").End(xlUp).Row
    
    For i = 0 + 2 To lastRow
        count = 0
        currentRow = i
        For j = 0 + 2 To currentRow
            If Cells(currentRow, "A") = Cells(j, "A") Then
                count = count + 1
                Cells(currentRow, "B") = Cells(j, "A") & "-" & count
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub

Sub 그룹별순번매기기_배열()
    Dim i As Long
    Dim j As Long
    Dim lastRow As Long
    Dim currentRow As Long
    Dim a()
    Dim rngS
    Dim count As Long
    
    Application.ScreenUpdating = False
    If Range("B2") <> "" Then
        Range("B2", Cells(Rows.count, "B").End(xlUp)).ClearContents
    End If
    
    rngS = Range("A2", Cells(Rows.count, "A").End(xlUp))
    
    
    lastRow = Cells(Rows.count, "A").End(xlUp).Row

    ReDim Preserve a(UBound(rngS))
    For i = 0 + 2 To lastRow
        count = 0
        currentRow = i
        For j = 0 + 2 To currentRow
            If Cells(currentRow, "A") = Cells(j, "A") Then
                count = count + 1
                a(j - 2) = Cells(j, "A") & "-" & count
'                Cells(currentRow, "B") = Cells(j, "A") & "-" & Count
            End If
        Next j
    Next i
    Range("B2").Resize(UBound(a), 1) = Application.Transpose(a)
    Application.ScreenUpdating = True
End Sub

VBA_그룹별순번매기기.xlsm
0.02MB