Nhờ trợ giúp về đánh số thứ tự

[longlt08]

Xin chào các anh, chị GPE !
Tôi học được cách đánh số thứ tự(STT) từ diễn đàn và đã áp dụng tốt cho loại biểu bảng có STT 1 cấp nhưng khi áp dụng cho ;oại biểu bảng có từ 2 cấp trở lên thì chỉ sử dụng được cho STT cấp 1 còn các cấp tiếp theo lại phải đánh thủ công. Tôi muốn nhờ các anh chị viết giúp đoạn code hoặc hàm để khi gặp loại biểu bảng có từ 2 hoặc 3 cấp trở lên vẫn có thể sử dụng được. Xin cảm ơn mọi người ! (có file gửi kèm theo)

 

[SA_DQ]

Macro của bạn đây & xem lại cách mà bạn quýnh vô dòng 45, nha.

Option Explicit

Sub LapSTT()
 Dim eRw As Long, LaMa As Byte, MLon As Byte, MNho As Byte
 Dim WF, Cls As Range, Rng As Range
 Dim sLama As String:                       Const DC As String = "."
 
 eRw = [C65500].End(xlUp).Row:              Set WF = Application.WorksheetFunction
 Set Rng = Range([A3], Cells(eRw, "A")):    Rng.Value = ""
 For Each Cls In Rng
    If Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value = "" _
        And Cls.Offset(1, 2).Value = "" Then
        LaMa = LaMa + 1:                    sLama = WF.Roman(LaMa)
        Cls.Value = sLama:                  MLon = 0
    ElseIf Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value = "" _
        And Cls.Offset(1, 2).Value <> "" Then
        MLon = 1 + MLon:                    MNho = 0
        Cls.Value = sLama & DC & MLon
    ElseIf Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value <> "" _
        And Cls.Offset(1).Value = "" Then
        MNho = 1 + MNho:                    Cls.Value = MNho
    End If
 Next Cls
End Sub

 

[TrungChinhs]

@ anh Long: Anh tham khảo File này, để chạy code anh nhấn vào STT trên tiêu đề cột.
Lưu ý là em đã cấu trúc lại biểu và muốn anh tham khảo thêm cách bố trí dữ liệu theo kiểu này (kiểu cây thư mục)

 

[longlt08]

Option Explicit
 
Sub LapSTT()
Dim eRw As Long, LaMa As Byte, MLon As Byte, MNho As Byte
Dim WF, Cls As Range, Rng As Range
Dim sLama As String: Const DC As String = "."
 
eRw = [C65500].End(xlUp).Row: Set WF = Application.WorksheetFunction
Set Rng = Range([A3], Cells(eRw, "A")): Rng.Value = ""
For Each Cls In Rng
If Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value = "" _
And Cls.Offset(1, 2).Value = "" Then
LaMa = LaMa + 1: sLama = WF.Roman(LaMa)
Cls.Value = sLama: MLon = 0
ElseIf Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value = "" _
And Cls.Offset(1, 2).Value <> "" Then
MLon = 1 + MLon: MNho = 0
Cls.Value = sLama & DC & MLon
ElseIf Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value <> "" _
And Cls.Offset(1).Value = "" Then
MNho = 1 + MNho: Cls.Value = MNho
End If
Next Cls
End Sub

Xin cảm ơn SA_DQ ! Tôi đã dùng macro cua bạn, STT đánh rất đúng. Bạn cho tôi hỏi thêm 1 chút: Từ macro đánh STT 3 cấp này bạn giúp tôi chuyển xuống 2 cấp được không ? Khi đó chỉ còn STT la mã và số 1,2...(có file kèm theo) Rất cảm ơn bạn !

 

[concogia]

Xin cảm ơn SA_DQ ! Tôi đã dùng macro cua bạn, STT đánh rất đúng. Bạn cho tôi hỏi thêm 1 chút: Từ macro đánh STT 3 cấp này bạn giúp tôi chuyển xuống 2 cấp được không ? Khi đó chỉ còn STT la mã và số 1,2...(có file kèm theo) Rất cảm ơn bạn !

Từ 3 lên 4, 5 mới khó chứ xuống 2 thì bạn bỏ bớt cái "thằng" Mnho trong code của bác Sa đi thôi mà
Chắc bác í đi uống cà phê zồi, mình sửa giúp bạn nhé

Sub LapSTT()
    Dim eRw As Long, LaMa As Byte, MLon As Byte, MNho As Byte
    Dim WF, Cls As Range, Rng As Range
    Dim sLama As String: Const DC As String = "."
        eRw = [C65500].End(xlUp).Row: Set WF = Application.WorksheetFunction
        Set Rng = Range([A3], Cells(eRw, "A")): Rng.Value = ""
            For Each Cls In Rng
                If Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2) = "" Then
                    LaMa = LaMa + 1: sLama = WF.Roman(LaMa)
                    Cls.Value = sLama: MLon = 0
                ElseIf Cls.Offset(, 1).Value <> "" And Cls.Offset(, 2).Value <> "" Then
                    MLon = 1 + MLon
                    Cls.Value = MLon
                End If
            Next Cls
End Sub

Thân

 

[SA_DQ]

Cò già đoán vậy mà gần đúng, nhỉ!

Mưu đồ có từ hôm qua, nhưng giờ mới tỉnh lại & xin đề đạt nguyện vọng đến Cò già & các bạn:

Chuyển các macro này sang hàm tự tạo xem sao!

Chúc vui & sức khoẻ!

​

 

[longlt08]

@ anh Long: Anh tham khảo File này, để chạy code anh nhấn vào STT trên tiêu đề cột.
Lưu ý là em đã cấu trúc lại biểu và muốn anh tham khảo thêm cách bố trí dữ liệu theo kiểu này (kiểu cây thư mục)

Xin chào Anh Trung Chinh !
Cách đánh STT của anh rất độc đáo. Tôi đang nghiên cứu để áp dụng. Tuy nhiên cách của anh phải thêm 2 cột nữa, tôi đánh STT cho bảng pivot nên nếu thêm cột thì dữ liệu cũng chỉ sắp xếp trong bảng pivot thôi không thể chờm ra ngoài bảng pivot được. Anh có thể sửa lại cách đánh STT như thế nhưng không phải thêm 2 cột nữa được không ? Cảm ơn anh về sự giúp đỡ.