Giúp đỡ ghi số thứ tự vào vùng MergCells (1 người xem)

[NguyenNgocSon]

Em có bài toán đánh số thứ tự như file
Kính mong anh chị nào có thời gian xem giúp
Trân trọng !

 

[jack nt]

Private Sub CommandButton1_Click()    
    Dim i&
    With UsedRange
        For i = 4 To .Row + .Rows.Count - 1
            If Cells(i, 1) <> vbNullString Then
                If Cells(i, 1).Address = Cells(i, 1).MergeArea(1).Address Then
                    danhSTT i, i + Cells(i, 1).MergeArea.Rows.Count - 1
                End If
            End If
        Next
    End With
End Sub


Private Sub danhSTT(FirstRow&, LastRow&)
    Dim i&, Dem&
    For i = FirstRow To LastRow
        If Cells(i, 4).Address = Cells(i, 4).MergeArea(1).Address Then
            Dem = Dem + 1
            Cells(i, 4) = Dem
        End If
    Next
End Sub