Code đánh số thứ tự

[DungMD]

Hiện tại tôi có bảng như sau, công thức tại ô A6 là là =IF(C6=C5,A5,A5+1) nhằm mục đích đánh số thứ tự, tuy nhiên tôi muốn chạy code VBA vì vậy tôi đã dùng macro để tạo lệnh Sub như phía dưới




Các bác cho tôi hỏi, tôi đã code như thế này đúng chưa ? và tôi muốn đánh không phải chỉ là tới ô "Range("A6:A8675").Select " mà là dòng có dữ liệu cuối cùng của cột C thì làm thế nào ?

Sub Macro5()
'
' Macro5 Macro
'
' Keyboard Shortcut: Ctrl+y
'



ActiveWindow.SmallScroll Down:=-15
Range("A6").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Range("A6:A8675").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B6").Select
End Sub

 

[SA_DQ]

Cách 1 (& đơn giản là mở bộ thu macro lên) để có macro sau:

Sub SoTT_()
'
' SoTT Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
    Range("A5").Select
    Selection.AutoFill Destination:=Range("A5:A13"), Type:=xlFillDefault
    Range("A5:A13").Select
End Sub

Sau đó bạn sửa nó lại như sau:

Sub SoTT()
 Dim Rws As Long
 
 Rws = [C5].CurrentRegion.Rows.Count
 [A5].FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
 [A5].Select
 Selection.AutoFill Destination:=[A5].Resize(Rws - 1), Type:=xlFillDefault
End Sub

Cách 2: Nếu dữ liệu ở nhiều dòng thì xài thử cái ni:

Sub DanhSoTTTrucTiep()
 Dim Rws As Long, J As Long
 
 [A5].Value = 1
 Rws = [C5].End(xlDown).Row
 For J = 6 To Rws
    If Cells(J, "C").Value = Cells(J - 1, "C").Value Then
        Cells(J, "A").Value = Cells(J - 1, "A").Value
    Else
        Cells(J, "A").Value = 1 + Cells(J - 1, "A").Value
    End If
 Next J
End Sub

 

[DungMD]

Cách 1 (& đơn giản là mở bộ thu macro lên) để có macro sau:

Sub SoTT_()
'
' SoTT Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
    Range("A5").Select
    Selection.AutoFill Destination:=Range("A5:A13"), Type:=xlFillDefault
    Range("A5:A13").Select
End Sub

Sau đó bạn sửa nó lại như sau:

Sub SoTT()
 Dim Rws As Long
 
 Rws = [C5].CurrentRegion.Rows.Count
 [A5].FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
 [A5].Select
 Selection.AutoFill Destination:=[A5].Resize(Rws - 1), Type:=xlFillDefault
End Sub

Cách 2: Nếu dữ liệu ở nhiều dòng thì xài thử cái ni:

Sub DanhSoTTTrucTiep()
 Dim Rws As Long, J As Long
 
 [A5].Value = 1
 Rws = [C5].End(xlDown).Row
 For J = 6 To Rws
    If Cells(J, "C").Value = Cells(J - 1, "C").Value Then
        Cells(J, "A").Value = Cells(J - 1, "A").Value
    Else
        Cells(J, "A").Value = 1 + Cells(J - 1, "A").Value
    End If
 Next J
End Sub

Dạ em cảm ơn bác ạ

 

[DungMD]

Cách 1 (& đơn giản là mở bộ thu macro lên) để có macro sau:

Sub SoTT_()
'
' SoTT Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
    Range("A5").Select
    Selection.AutoFill Destination:=Range("A5:A13"), Type:=xlFillDefault
    Range("A5:A13").Select
End Sub

Sau đó bạn sửa nó lại như sau:

Sub SoTT()
 Dim Rws As Long
 
 Rws = [C5].CurrentRegion.Rows.Count
 [A5].FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
 [A5].Select
 Selection.AutoFill Destination:=[A5].Resize(Rws - 1), Type:=xlFillDefault
End Sub

Cách 2: Nếu dữ liệu ở nhiều dòng thì xài thử cái ni:

Sub DanhSoTTTrucTiep()
 Dim Rws As Long, J As Long
 
 [A5].Value = 1
 Rws = [C5].End(xlDown).Row
 For J = 6 To Rws
    If Cells(J, "C").Value = Cells(J - 1, "C").Value Then
        Cells(J, "A").Value = Cells(J - 1, "A").Value
    Else
        Cells(J, "A").Value = 1 + Cells(J - 1, "A").Value
    End If
 Next J
End Sub

Em hỏi thêm chút, vậy có cách nào ngoài cách viết công thức và coppy mà biến luôn công thức tại cột A thành =IF(C6=C5,A5,A5+1) thành code trực tiếp được không ạ ( ngoại trừ A5 tự đánh STT1, còn các dòng A sau tự nhảy theo code mà ko cần nhấn sub

Bài đã được tự động gộp: 21/6/21

Cách 1 (& đơn giản là mở bộ thu macro lên) để có macro sau:

Sub SoTT_()
'
' SoTT Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
    Range("A5").Select
    Selection.AutoFill Destination:=Range("A5:A13"), Type:=xlFillDefault
    Range("A5:A13").Select
End Sub

Sau đó bạn sửa nó lại như sau:

Sub SoTT()
 Dim Rws As Long
 
 Rws = [C5].CurrentRegion.Rows.Count
 [A5].FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C,N(R[-1]C)+1)"
 [A5].Select
 Selection.AutoFill Destination:=[A5].Resize(Rws - 1), Type:=xlFillDefault
End Sub

Cách 2: Nếu dữ liệu ở nhiều dòng thì xài thử cái ni:

Sub DanhSoTTTrucTiep()
 Dim Rws As Long, J As Long
 
 [A5].Value = 1
 Rws = [C5].End(xlDown).Row
 For J = 6 To Rws
    If Cells(J, "C").Value = Cells(J - 1, "C").Value Then
        Cells(J, "A").Value = Cells(J - 1, "A").Value
    Else
        Cells(J, "A").Value = 1 + Cells(J - 1, "A").Value
    End If
 Next J
End Sub

Công thức thứ 2 hơi nặng a, e dùng nhưng bị xoay vòng

 

[concogia]

Em hỏi thêm chút, vậy có cách nào ngoài cách viết công thức và coppy mà biến luôn công thức tại cột A thành =IF(C6=C5,A5,A5+1) thành code trực tiếp được không ạ ( ngoại trừ A5 tự đánh STT1, còn các dòng A sau tự nhảy theo code mà ko cần nhấn sub

1) Nếu không cần nhìn thấy công thức thì dùng mảng, cái này code chạy nhanh hơn nhiều
2) "còn các dòng A sau tự nhảy theo code mà ko cần nhấn sub" cái này cũng được, nhưng mình nghĩ bạn đã gán được phím tắt (Ctr + y ) cho code thì nhập dữ liệu ở [A5] xong bấm một phát là xong chứ có cực gì hơn đâu
Nếu có file thì làm "tý tẹo" là xong thôi
Thân

 

[Maika8008]

Em hỏi thêm chút, vậy có cách nào ngoài cách viết công thức và coppy mà biến luôn công thức tại cột A thành =IF(C6=C5,A5,A5+1) thành code trực tiếp được không ạ ( ngoại trừ A5 tự đánh STT1, còn các dòng A sau tự nhảy theo code mà ko cần nhấn sub

Bạn chép code vào trang code VBA của sheet cần đánh số thứ tự

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr, i&
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Target.Address = "$A$5" Then
        arr = Range("A5:C" & Range("C" & Rows.Count).End(xlUp).Row)
        Application.EnableEvents = False
        For i = 1 To UBound(arr)
            On Error Resume Next
            If arr(i, 3) = arr(i - 1, 3) Then
                If Err.Number = 9 Then
                    Err.Clear
                    GoTo Tiep
                End If
                arr(i, 1) = arr(i - 1, 1)
            Else
                arr(i, 1) = arr(i - 1, 1) + 1
            End If
Tiep:   Next
    End If
    Range("A5").Resize(UBound(arr), 1) = arr
    Application.EnableEvents = True
End Sub

 

[VetMini]

1) Nếu không cần nhìn thấy công thức thì dùng mảng, cái này code chạy nhanh hơn nhiều
2) "còn các dòng A sau tự nhảy theo code mà ko cần nhấn sub" cái này cũng được, nhưng mình nghĩ bạn đã gán được phím tắt (Ctr + y ) cho code thì nhập dữ liệu ở [A5] xong bấm một phát là xong chứ có cực gì hơn đâu
Nếu có file thì làm "tý tẹo" là xong thôi
Thân

Trời. Ở GPE bao lâu rồi mà còn nói câu nghe ngây thơ hết sức.
Nguyên tắc của dân xin code là: càng "tự động" càng khỏe thân. Vòi được thì mắc mớ gì phải nhịn thèm. Người khác ra công viết code chứ có phải mình đâu.

 

[DungMD]

1) Nếu không cần nhìn thấy công thức thì dùng mảng, cái này code chạy nhanh hơn nhiều
2) "còn các dòng A sau tự nhảy theo code mà ko cần nhấn sub" cái này cũng được, nhưng mình nghĩ bạn đã gán được phím tắt (Ctr + y ) cho code thì nhập dữ liệu ở [A5] xong bấm một phát là xong chứ có cực gì hơn đâu
Nếu có file thì làm "tý tẹo" là xong thôi
Thân

Vâng, cảm ơn Anh đã giúp

Bài đã được tự động gộp: 21/6/21

Bạn chép code vào trang code VBA của sheet cần đánh số thứ tự

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr, i&
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Target.Address = "$A$5" Then
        arr = Range("A5:C" & Range("C" & Rows.Count).End(xlUp).Row)
        Application.EnableEvents = False
        For i = 1 To UBound(arr)
            On Error Resume Next
            If arr(i, 3) = arr(i - 1, 3) Then
                If Err.Number = 9 Then
                    Err.Clear
                    GoTo Tiep
                End If
                arr(i, 1) = arr(i - 1, 1)
            Else
                arr(i, 1) = arr(i - 1, 1) + 1
            End If
Tiep:   Next
    End If
    Range("A5").Resize(UBound(arr), 1) = arr
    Application.EnableEvents = True
End Sub

Cảm ơn bác, minh đã dùng rất ok

Bài đã được tự động gộp: 21/6/21

Trời. Ở GPE bao lâu rồi mà còn nói câu nghe ngây thơ hết sức.
Nguyên tắc của dân xin code là: càng "tự động" càng khỏe thân. Vòi được thì mắc mớ gì phải nhịn thèm. Người khác ra công viết code chứ có phải mình đâu.

Thanks bác đã chỉ bảo

 

[DungMD]

Cách 1 (& đơn giản là mở bộ thu macro lên) để có macro sau:

Sub SoTT_()
'
' SoTT Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
 
[/QUOTE]
Thưa bác tôi xin nhờ Bác giúp đỡ tôi tiếp của bài toán cũ, hiện tại tôi thay đổi hàm từ =IF(C6=C5,A5,A5+1) sang trường hợp phức tạp hơn đó là
"Nếu năm của cột D thay đổi, số được đánh lại từ 1" thì làm thế nào. Tôi xin cảm ơn rất nhiều