Code đánh số thứ tự (1 người xem)

DungMD · 21/6/21

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 · 21/6/21

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

Mã:

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:

PHP:

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:

PHP:

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 · 21/6/21

SA_DQ đã viết:

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

Mã:

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:

PHP:

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:

PHP:

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 · 21/6/21

SA_DQ đã viết:

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

Mã:

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:

PHP:

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:

PHP:

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

SA_DQ đã viết:

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

Mã:

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:

PHP:

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:

PHP:

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 · 21/6/21

DungMD đã viết:
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 · 21/6/21

DungMD đã viết:
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ự

Rich (BB code):

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 · 21/6/21

concogia đã viết:
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 · 21/6/21

concogia đã viết:
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

Maika8008 đã viết:

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

Rich (BB code):

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

VetMini đã viết:
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 · 12/7/21

SA_DQ đã viết:

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

Mã:

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

Code đánh số thứ tự (1 người xem)

Người dùng đang xem chủ đề này

DungMD

Thành viên chính thức

SA_DQ

/(hông là gì!

DungMD

Thành viên chính thức

DungMD

Thành viên chính thức

concogia

Gội rồi mới Cạo

Maika8008

Thành viên gạo cội

VetMini

Ăn cùng góc phố

DungMD

Thành viên chính thức

DungMD

Thành viên chính thức

File đính kèm

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian