Giúp tôi code điền số thứ tự tự động (1 người xem)

[hoang0569]

Anh chị Giúp tôi code điền số thứ tự tự động, tôi gửi File kèm mong anh chị giúp, cảm ơn nhiều.

 

[quanluu]

anh chị giúp tôi code điền số thứ tự tự động, tôi gửi file kèm mong anh chị giúp, cảm ơn nhiều.

a2=if(b2<>b1,max($a$1:a1)+1,"")

 

[hoang0569]

Cảm ơn bạn, mình muốn thực hiện bằng code bạn ơi.

 

[HungQuoc49]

Anh chị Giúp tôi code điền số thứ tự tự động, tôi gửi File kèm mong anh chị giúp, cảm ơn nhiều.

Bạn có thể giải thích "tự động" cụ thể nghĩa là khi nào thì nhập?

 

[quanluu]

Cảm ơn bạn, mình muốn thực hiện bằng code bạn ơi.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j, currentrow As Integer
    If Target.Column = 2 Then
        currentrow = Target.Row
        For i = 2 To currentrow
        If Cells(i, 2) <> Cells(i - 1, 2) Then
            For j = i - 1 To 1 Step -1
                If Cells(j, 1) <> "" Then
                    Cells(i, 1) = Cells(j, 1) + 1
                    GoTo 1
                End If
            Next
        End If
1:
    Next
    End If
    
End Sub

 

[hoang0569]

Code không chạy bạn ơi, mình dùng office 2003.

 

[quanluu]

Code không chạy bạn ơi, mình dùng office 2003.

code này là code tự động mà bạn, bạn gõ giá trị từ B10 trở đi để test, khi bạn gõ khác giá trị thì nó nhay số ko thì nó để trống

 

[hoang0569]

Bạn gởi file cho tôi đi, sao tôi không chạy được, cảm ơn bạn nhiều.

 

[quanluu]

Bạn gởi file cho tôi đi, sao tôi không chạy được, cảm ơn bạn nhiều.

Bạn gõ dữ liệu từ B2 trở đi.

 

[hoang0569]

Bạn sửa giúp mình sao cho khi nhập dữ liệu vào cột B thì cột A mới tự động đánh số từ 1 không?

 

[quanluu]

Bạn sửa giúp mình sao cho khi nhập dữ liệu vào cột B thì cột A mới tự động đánh số từ 1 không?

không hiểu ý bạn lắm, nhưng bạn check file xem tn.

 

[Miccpro]

Cũng câu hỏi này, các bác có thể giúp em đánh thứ tự theo dạng 01; 02; 03; ....; 09; 10; ... để "mail merge" cho đẹp được không ạ?

 

[quanluu]

Cũng câu hỏi này, các bác có thể giúp em đánh thứ tự theo dạng 01; 02; 03; ....; 09; 10; ... để "mail merge" cho đẹp được không ạ?

Cái này thuộc về format thui mà. Chọn cột vào format chọn custom đánh 00

 

[Miccpro]

Cái này thuộc về format thui mà. Chọn cột vào format chọn custom đánh 00

Nếu format thì lúc mail merge chẳng hạn nó lại hiển thị là 1; 2; 3 ... bác ạ

 

[quanluu]

Nếu format thì lúc mail merge chẳng hạn nó lại hiển thị là 1; 2; 3 ... bác ạ

code này vậy

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j, lastrow, dem As Integer
dem = 1
    If Target.Column = 2 Then
        Cells(1, 1) = "'01"
        lastrow = Range("B" & Rows.Count).End(3).Row
        If lastrow > 1 Then Range("A2:A" & lastrow).Clear
        For i = 2 To lastrow
            If Cells(i, 2) <> Cells(i - 1, 2) Then
                dem = dem + 1
                Cells(i, 1) = "'" & Right("00" & dem, 2)
            End If
        Next
    End If
End Sub

 

[Miccpro]

code này vậy

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j, lastrow, dem As Integer
dem = 1
    If Target.Column = 2 Then
        Cells(1, 1) = "'01"
        lastrow = Range("B" & Rows.Count).End(3).Row
        If lastrow > 1 Then Range("A2:A" & lastrow).Clear
        For i = 2 To lastrow
            If Cells(i, 2) <> Cells(i - 1, 2) Then
                dem = dem + 1
                Cells(i, 1) = "'" & Right("00" & dem, 2)
            End If
        Next
    End If
End Sub

Cảm ơn bác rất nhiều, em có bài toán này khó hơn, mong bác giúp em được không ạ, thanks nhiều

 

[quanluu]

Cảm ơn bác rất nhiều, em có bài toán này khó hơn, mong bác giúp em được không ạ, thanks nhiều

Thì đây

Sub run()
Dim i, dem As Integer
    For i = 7 To Range("C6000").End(3).Row
        If Cells(i, 2) = "HM" Then dem = 0
        If Cells(i, 3) <> "" And Cells(i, 2) <> "HM" Then
            dem = dem + 1
            Cells(i, 1) = "'" & Right("00" & dem, 2)
        End If
    Next
End Sub

 

[Miccpro]

Thì đây

Sub run()
Dim i, dem As Integer
    For i = 7 To Range("C6000").End(3).Row
        If Cells(i, 2) = "HM" Then dem = 0
        If Cells(i, 3) <> "" And Cells(i, 2) <> "HM" Then
            dem = dem + 1
            Cells(i, 1) = "'" & Right("00" & dem, 2)
        End If
    Next
End Sub

Híc, nó chạy được nhưng phải gán nút bác ạ, em muốn tự động có được không

 

[Miccpro]

Em đã sửa tên thành Private Sub Worksheet_Change(ByVal Target As Range) để tự động chạy nhưng được khoảng vài dòng thì máy bị treo bác ạ

 

[quanluu]

Em đã sửa tên thành Private Sub Worksheet_Change(ByVal Target As Range) để tự động chạy nhưng được khoảng vài dòng thì máy bị treo bác ạ

Dữ liệu của bạn nhiều??? Có gì đâu mà treo dc nhỉ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, dem As Integer
If Target.Column = 2 Or Target.Column = 3 Then
    Range("A7:A1000").ClearContents
    For i = 7 To Range("C6000").End(3).Row
        If Cells(i, 2) = "HM" Then dem = 0
        If Cells(i, 3) <> "" And Cells(i, 2) <> "HM" Then
            dem = dem + 1
            Cells(i, 1) = "'" & Right("00" & dem, 2)
        End If
    Next
End If
End Sub

 

[Miccpro]

Dữ liệu của bạn nhiều??? Có gì đâu mà treo dc nhỉ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, dem As Integer
If Target.Column = 2 Or Target.Column = 3 Then
    Range("A7:A1000").ClearContents
    For i = 7 To Range("C6000").End(3).Row
        If Cells(i, 2) = "HM" Then dem = 0
        If Cells(i, 3) <> "" And Cells(i, 2) <> "HM" Then
            dem = dem + 1
            Cells(i, 1) = "'" & Right("00" & dem, 2)
        End If
    Next
End If
End Sub

Làm phiền bác quanluu tý. Với code này giờ em lại muốn gán nút thì sửa thế nào ạ,