Xin code đánh số thứ tự theo nhóm (1 người xem)

[hiepnh1985]

Em đã đọc 33 bài trong chủ đề đánh số thứ tự. Nhưng em vẫn chưa ứng dụng được code để đánh số thứ tự theo nhóm. Em gửi file đính kèm nhờ mọi người giúp đỡ. Cột A là số thứ tự. Cột B là nội dung. Trong cột A phân thành các nhóm, mỗi nhóm phân biệt bằng chữ cái "A, B, C,...". Sau mỗi chữ cái đó là số thứ tự tăng liên tục 1, 2, 3, 4, 5 khi nhập dữ liệu ở cột B. Một chú ý nữa là nếu em có Del dòng hoặc chèn dòng để bổ sung dữ liệu ở cột B thì số thứ tự cũng tự động được sắp xếp lại. Các bác có ai biết thì giúp em nhé. Em xin code VBA để cho nhẹ file. Em xin cảm ơn

 

[vodoi2x]

Để đơn giản vấn đề thì

- tại A3, gõ công thức

=IF(ISNUMBER(A2),A2+1,1)

- kéo ct trên xuống A4, A5..... hết

- nhập các A, B, ... vào A2, A7 .....

là được

* khi xóa, hay chèn dòng, thì copy công thức lân cận cho các dòng mới đó cho hợp lý

---> như thế đơn giản , thật đơn giản -- vì kiểu gì chúng ta chẳng phải nhập A, B, C....

 

[leonguyenz]

Tham khảo code này xem:
[gpecode=vb]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
If Not Intersect(Range("A2:B500"), Target) Is Nothing Then
i = 2
Do
i = i + 1
If Cells(i + 1, 2) = "" Then
Cells(i + 1, 1) = ""
End If
If IsNumeric(Cells(i + 1, 1)) Or IsNull(Cells(i + 1, 1)) Then
Cells(i + 1, 1) = Application.Max(Cells(i, 1)) + 1
End If
Loop Until IsEmpty(Cells(i + 2, 2))
End If
End Sub
[/gpecode]

 

[TrungChinhs]

Tham khảo thêm code này nữa !
Ưu điểm: không dùng vòng lặp
Nhược điểm: phải để công thức trong cột STT

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [b2:b65000]) Is Nothing Then
        On Error Resume Next
        With Range("a2:a" & [b65000].End(3).Row)
            .SpecialCells(3).ClearContents
            .SpecialCells(4) = "=MAX(R[-1]C)+1"
        End With
    End If
End Sub

Nếu dùng vòng lặp thì thử code này.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    For Each cls In Range("a2:a" & [b65000].End(3).Row)
        If cls < 1000000000 And cls(1, 2) > 0 Then cls.Value = "=MAX(R[-1]C)+1"
        cls=cls.Value
    Next
End Sub

 

[hiepnh1985]

Tham khảo code này xem:
[gpecode=vb]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
If Not Intersect(Range("A2:B500"), Target) Is Nothing Then
i = 2
Do
i = i + 1
If Cells(i + 1, 2) = "" Then
Cells(i + 1, 1) = ""
End If
If IsNumeric(Cells(i + 1, 1)) Or IsNull(Cells(i + 1, 1)) Then
Cells(i + 1, 1) = Application.Max(Cells(i, 1)) + 1
End If
Loop Until IsEmpty(Cells(i + 2, 2))
End If
End Sub
[/gpecode]

Đúng là cái em cần. Em muốn không có công thức trong bảng tính để giảm dung lượng file. Hôm nay định hỏi anh trên skype nhưng lúc đó anh không online. Chiều định gọi hỏi lại quên. Để em ngâm cứu code cái. Thank anh nhé.

 

[Pirate]

Bạn có thể viết giúp mình code theo file đính kèm được không vậy.

 

[giangleloi]

Bạn có thể viết giúp mình code theo file đính kèm được không vậy.

Bạn chọn dữ liệu cột A. Bấm Ctrl + 1 => Chọn General là được. Code "kiếc" làm chi vậy.