Cần giúp đỡ VBA đánh số thứ tự tăng dần cho những dữ liệu giống nhau (1 người xem)

[ngohaichau]

Dear cả nhà, qua mấy ngày tìm hiểu và tập tành với VBA thì mình vẫn chưa giải quyết được vấn đề đánh số thứ tự tăng dần cho những dữ liệu giống nhau, mong cả nhà giúp đỡ.

Hiện mình có file dữ liệu như file đính kèm, nếu 4 cột Dept, Devision, Method, Cat giống nhau thì số No.of program sẽ tăng dần.

Mong cả nhà hỗ trợ mình đoạn code để có thể thực hiện được yêu cầu trên.

Thân!

 

[concogia]

Dear cả nhà, qua mấy ngày tìm hiểu và tập tành với VBA thì mình vẫn chưa giải quyết được vấn đề đánh số thứ tự tăng dần cho những dữ liệu giống nhau, mong cả nhà giúp đỡ.

Hiện mình có file dữ liệu như file đính kèm, nếu 4 cột Dept, Devision, Method, Cat giống nhau thì số No.of program sẽ tăng dần.

Mong cả nhà hỗ trợ mình đoạn code để có thể thực hiện được yêu cầu trên.

Thân!

Thử code này xem sao:

Public Sub Stt()
    Dim Vung, d, I, Mg, Gom
        Set d = CreateObject("scripting.dictionary")
        Vung = Range([C2], [C50000].End(xlUp)).Resize(, 4)
        ReDim Mg(1 To UBound(Vung), 1 To 1)
            For I = 1 To UBound(Vung)
                Gom = Vung(I, 1) & Vung(I, 2) & Vung(I, 3) & Vung(I, 4)
                    If Not d.exists(Gom) Then
                        d.Add Gom, 1
                        Mg(I, 1) = 1
                    Else
                        d.Item(Gom) = d.Item(Gom) + 1
                        Mg(I, 1) = d.Item(Gom)
                    End If
            Next I
    [G2].Resize(UBound(Vung)) = Mg
End Sub

Thân

 

[ngohaichau]

Cảm ơn anh concogia, code anh cung cấp đã hoạt động đúng như theo yêu cầu của em, nhưng có cách nào để nó có thể chạy tự động không anh?

Thân!

 

[ngohaichau]

Em có thêm vô code như vậy để nó có thể chạy tự động nếu cột ngày thay đổi.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H2:H2000")) Is Nothing Then
On Error GoTo Loi
If Target.Value <> "" Then
Dim Vung, d, I, Mg, Gom
Set d = CreateObject("scripting.dictionary")
Vung = Range([B2], [B50000].End(xlUp)).Resize(, 4)
ReDim Mg(1 To UBound(Vung), 1 To 1)
For I = 1 To UBound(Vung)
Gom = Vung(I, 1) & Vung(I, 2) & Vung(I, 3) & Vung(I, 4)
If Not d.exists(Gom) Then
d.Add Gom, 1
Mg(I, 1) = 1
Else
d.Item(Gom) = d.Item(Gom) + 1
Mg(I, 1) = d.Item(Gom)
End If
Next I
[F2].Resize(UBound(Vung)) = Mg
End If
End If
Loi:
End Sub

Hàm code như vậy đã tối ưu chưa nhỉ?

 

[VetMini]

Em có thêm vô code như vậy để nó có thể chạy tự động nếu cột ngày thay đổi.
...
Hàm code như vậy đã tối ưu chưa nhỉ?

Tối ưu không phải là trạng thái tuyệt đối. Tối ưu trên phương diện A có thể phải hy sinh phương diện B.

Bạn muốn chú trọng trên phương diện nào?

Trước mắt là sự kiện Worksheet_Change là cách hoạt động cập nhật tại chỗ và tức thời, rất hiếm khi được coi là cách giải quyết tối ưu. Cách giải quyết tối ưu thường là gom lại nhiều lần thay đổi rồi cập nhật một lần.

Thứ hai, code hoạt động tại chỗ và tức thời mà dùng ọbject dic thì mỗi lần có sự kiện, nó phải lập một object, gom dữ liệu nhét cho đầy rồi cập nhật. Cập nhật xong thì huỷ object đi.

Tôi chỉ nói trên phương diện cơ cấu hoạt động. Nếu bạn chỉ chú trọng về tốc độ code hay gì gì đó thì là chuyện khác, cứ coi như tôi không có nói gì cả.

 

[comet_1701]

Dear cả nhà, qua mấy ngày tìm hiểu và tập tành với VBA thì mình vẫn chưa giải quyết được vấn đề đánh số thứ tự tăng dần cho những dữ liệu giống nhau, mong cả nhà giúp đỡ.

Hiện mình có file dữ liệu như file đính kèm, nếu 4 cột Dept, Devision, Method, Cat giống nhau thì số No.of program sẽ tăng dần.

Mong cả nhà hỗ trợ mình đoạn code để có thể thực hiện được yêu cầu trên.

Thân!

Option Explicit
Public Sub Stt()
    Dim Vung, I, Mg, Gom
    Vung = Range([C2], [C50000].End(xlUp)).Resize(, 4)
    ReDim Mg(1 To UBound(Vung), 1 To 1)
    With CreateObject("Scripting.dictionary")
            For I = 1 To UBound(Vung)
                Gom = Vung(I, 1) & Vung(I, 2) & Vung(I, 3) & Vung(I, 4)
                    If Not .exists(Gom) Then
                        .Add Gom, 1
                        Mg(I, 1) = 1
                    Else
                        .Item(Gom) = .Item(Gom) + 1
                        Mg(I, 1) = .Item(Gom)
                    End If
            Next I
    End With
    [G2].Resize(UBound(Vung)) = Mg
End Sub

Thêm một cách viết khác nữa về Dictionary nhé. Mình chỉ sửa một chút của lão tiền bối Concogia thôi

 

[OverAC]

Vì bạn nói là đang tập thành viết code nên mọi người vào giúp bạn toàn chuyên gia code.
Nhưng nếu có cách công thức không dùng code ban có muốn dùng không?
Viết công thức này vào ô G2 và filldown =COUNTIFS($C$1:C2,C2,$D$12,D2,$E$1:E2,E2,$F$1:F2,F2)

 

[ngohaichau]

Cảm ơn bạn OverAC, công thức của bạn chạy cũng rất tốt, phù hợp với yêu cầu của mình, vậy là học được thêm 1 cách nữa.

To VetMini, nếu như mình muốn gom nhiều lần thay đổi lại 1 lần rồi mới cập nhật thì code phải thay đổi như thế nào? Hay ý của bạn là mình phải nhập nhiều dữ liệu 1 lần rồi mới chạy tay macro để nó cập nhật 1 lần, nếu vậy thì đâu có tự động đâu nhỉ?

Thân!