Tự động đánh 2 kiểu STT trong cùng 1 cột

[TrungChinhs]

Nhờ các bạn viết code để tự động đánh 2 kiểu số thứ tự trong cùng một cột tức là tại cột A có STT kiểu số 1, 2, 3 ...đánh theo điều kiện của cột B và và kiểu tex 1.1, 1.2, 1.3 ...đánh theo điều kiện của cột C (ví dụ trong file đính kèm). Xin cảm ơn !

 

[BNTT]

Dựa vào cái file bạn đưa lên, tớ làm bằng công thức "củ chuối" này nhé:

=IF(G2="", COUNTA($F$2:F2), COUNTA($F$2:F2) & "." & RIGHT(G2))​

 

[chibi]

Và đây là code để bạn tham khảo

Option Explicit
Sub stt()
    Dim i As Integer, j As Integer, k As Integer, lRow As Integer
    lRow = [C65536].End(xlUp).Row
    j = 0
    With [A1]
        For i = 1 To lRow - 1
            If Len(.Offset(i, 2).Value) = 0 Then
                j = j + 1
                .Offset(i).Value = j
                k = 0
            Else
                k = k + 1
                .Offset(i).Value = j & "_" & k
            End If
        Next
    End With
End Sub

 

[SA_DQ]

Thêm một tham khảo nữa đây, không khác nhau mấy!

Option Explicit
Sub GhiSoTT()
 Dim lRow As Long, Ff As Long
 Dim JjB As Integer, jJC As Integer
 
 lRow = [c65500].End(xlUp).Row
 Range([a2], Cells(lRow + 9, "A")).Clear
 For Ff = 2 To lRow
   With Cells(Ff, 1)
      If .Offset(, 1) <> "" Then
         jJC = 0:                            JjB = JjB + 1
         .Value = JjB:                       .Font.Bold = True
         .HorizontalAlignment = xlCenter
      Else
         jJC = jJC + 1:                .Value = JjB & "." & jJC
      End If
   End With
 Next Ff
End Sub

 

[TrungChinhs]

Nhờ sửa code đánh STT kiểu tex

Option Explicit
Sub GhiSoTT()
 Dim lRow As Long, Ff As Long
 Dim JjB As Integer, jJC As Integer
 
 lRow = [c65500].End(xlUp).Row
 Range([a2], Cells(lRow + 9, "A")).Clear
 For Ff = 2 To lRow
   With Cells(Ff, 1)
      If .Offset(, 1) <> "" Then
         jJC = 0:                            JjB = JjB + 1
         .Value = JjB:                       .Font.Bold = True
         .HorizontalAlignment = xlCenter
      Else
         jJC = jJC + 1:                .Value = JjB & "." & jJC
      End If
   End With
 Next Ff
End Sub

Chào các bạn ! Đoạn code trên tự động đánh 2 kiểu số thứ tự (kiểu số và kiểu tex) trong cùng một cột, sau khi chạy thử mình thấy các STT kiếu số đánh rất chuẩn nhưng các STT kiểu tex chưa chuẩn lắm, cụ thể như sau:
- các số n.n0 đánh thành n.n (vd 1.10 đánh thành 1.1; 3.20 đánh thành 3.2 ...).
- các dòng rỗng vẫn đánh STT

ngoài nội dung trên mình muốn hỏi thêm: nếu muốn STT được đánh tại một cột bất kỳ (không phải là cột A) thì sửa code như thế nào ?
Rất mong các bạn quan tâm giúp đỡ. Thanks !

 

[SA_DQ]

Đúng là còn sơ sót, chưa kiểm kỹ! Cho xin lỗi nha!!

Sẽ là như sau:

Option Explicit
Sub GhiSoTT()
 Dim lRow As Long, Ff As Long
 Dim JjB As Integer, jJC As Integer
 
 lRow = [c65500].End(xlUp).Row
 Range([a2], Cells(lRow + 9, "A")).Clear
 For Ff = 2 To lRow
4   With Cells(Ff, 1)
      If .Offset(, 1) <> "" Then
         jJC = 0:                            JjB = JjB + 1
         .Value = JjB:                       .Font.Bold = True
         .HorizontalAlignment = xlCenter
9      ElseIf .Offset(, 1) = "" And .Offset(, 2) <> "" Then
         jJC = jJC + 1:                .Value = JjB & "." & jJC
11         If jJC Mod 10 = 0 Then .Offset().NumberFormat = "0.00"
      End If
   End With
 Next Ff
End Sub

- các số n.n0 đánh thành n.n (vd 1.10 đánh thành 1.1; 3.20 đánh thành 3.2 ...).

Đã khắc phục bằng dòng lệnh 11, đã sửa so với trước;
Chú ý: nếu lên hơn 99 thì lại phải thêm dòng lệnh nữa tương ứng với sự kiệm MOD 100 = 0;

- các dòng rỗng vẫn đánh STT

Đã sửa lại bằng dòng lệnh 9

nếu muốn STT được đánh tại một cột bất kỳ (không phải là cột A) thì sửa code NTN ?

Con số 1 trong dòng lệnh 4 biểu thị cho cột 'A'
Ta có thể sửa nó lại như sau:

4   With Cells(Ff, "A")

Một khi bạn sửa/chuyển 'A' thành ký tự/ký số khác, thì chú ý các thuộc tính OFSET(,) ở các câu lệnh dưới kề nó một tẹo, nha! Thường thì nó vẫn phù hợp, một khi CSDL của bạn là bình thường!

 

[TrungChinhs]

Nhờ sửa lỗi đánh STT...

Cảm ơn Bác HYen rất nhiều ! em đã chạy thử kết quả rất tốt. Trước đây em thường làm bằng các hàm IF, COUNTIF, AND... và phải mất tới 3 cột phụ và khổ nhất là mỗi khi thêm dòng phải dặm lại công thức nay được cái này thật là hữu dụng.

Hôm nay mới phát hiện lỗi không đánh STT kiểu tex cho nhóm cuối cùng. Nhờ Bác HYen sửa giúp. Cảm ơn Bác nhiều !

 

[ndu96081631]

Thử code này:

Sub STT()
  Dim Rng As Range, Clls As Range
  Dim Stt1 As Long, Stt2 As Long
  Set Rng = Range("E2:E" & [G65536].End(xlUp).Row)
  Rng.ClearContents
  For Each Clls In Rng
    If Clls.Offset(, 1) <> "" Then
       Stt1 = Stt1 + 1: Clls = Stt1: Stt2 = 0
    Else:
      If Clls.Offset(, 2) <> "" Then
         Stt2 = Stt2 + 1
         Clls = Stt1 & "." & Format(Stt2, "00")
      End If
    End If
  Next
End Sub

Tôi có cãm giác thậm chí không cần IF cái nào cả vẩn ra kết quả (nhưng vẩn chưa nghĩ ra)

 

[TrungChinhs]

Nhờ sửa code đánh STT

Bác ndu96081631 ơi STT kiểu tex không đánh được các số 0 hàng chục (hết .9 lại đến .1 hoặc .2, ... không đánh được .10, .20, ...) Bác xem lại và sửa giúp nhé, Cảm ơn bác nhiều !

 

[ThuNghi]

Bác ndu96081631 ơi STT kiểu tex không đánh được các số 0 hàng chục (hết .9 lại đến .1 hoặc .2, ... không đánh được .10, .20, ...) Bác xem lại và sửa giúp nhé, Cảm ơn bác nhiều !

Có phải bạn muốn 1.01 thành 1.1 và 1.10 là 1.10
Bạn sử dòng code của ndu như sau:
Clls = Stt1 & "." & Format(Stt2, "00")
thành
Clls = Stt1 & "." & Stt2

 

[TrungChinhs]

Có phải bạn muốn 1.01 thành 1.1 và 1.10 là 1.10
Bạn sử dòng code của ndu như sau:
Clls = Stt1 & "." & Format(Stt2, "00")
thành
Clls = Stt1 & "." & Stt2

Cảm ơn Bác! Em đã sửa nhưng vẫn không đựơc

 

[ndu96081631]

Cảm ơn Bác! Em đã sửa nhưng vẫn không đựơc

Sửa lại thế này nha:

Sub STT()
  Dim Rng As Range, Clls As Range
  Dim Stt1 As Long, Stt2 As Long
  Set Rng = Range("E2:E" & [G65536].End(xlUp).Row)
  Rng.ClearContents
  For Each Clls In Rng
    Clls.HorizontalAlignment = 3: Clls.NumberFormat = "@"
    If Clls.Offset(, 1) <> "" Then
        Stt1 = Stt1 + 1: Clls = Stt1: Stt2 = 0
    Else:
        If Clls.Offset(, 2) <> "" Then
            Stt2 = Stt2 + 1: Clls = Stt1 & "." & Stt2
        End If
    End If
  Next
End Sub