Đánh số thứ tự dạng 1, 1.1, 1.2, 1.3 ,…

Chia sẻ bởi:hands

★★★★★

‹ Gửi email tiếng Việt từ VBA Anh chị giúp em đánh STT với... ›

Quảng cáo

Nhờ các anh chị giúp em viết code đánh số thứ tự dạng 1, 1.1, 1.2, …
Như ví dụ em gởi trong file đính kèm
Trân trọng cảm ơn

Bạn thử code này xem sao:

Sub Stt()    
    Dim SrcArr, ResArr()
    Dim lR As Long, k As Long, lStt As Long
    Dim sStt As String

SrcArr = Sheet1.Range(Sheet1.Range("D3"), Sheet1.Range("D65000").End(xlUp)).Resize(, 2).Value2
    ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 1)

If IsArray(SrcArr) Then
        For lR = 1 To UBound(SrcArr, 1)
            If SrcArr(lR, 2) = "" Then
                lStt = lStt + 1
                k = 0
                ResArr(lR, 1) = lStt
            Else
                k = k + 1
                sStt = lStt & "." & k
                ResArr(lR, 1) = sStt
            End If
        Next lR
        With Sheet1
            .Range("B3:B10000").ClearContents
            .Range("B3").Resize(lR - 1, 1).Value = ResArr
        End With
    End If

End Sub