Nhờ hướng dẫn viết Code Vba thay hàm Countifs

[kientung]

Xin chào anh,chị,thầy,cô trong diễn đàn.

Em có một File Excel chứa dữ liệu tầm 150000 và đang xài hàm Countifs để đếm số lần xuất hiện.

Do dữ liệu nhiều nên xài công thức chạy chậm và dễ bị đứng máy.

Kết quả mong muốn là ở cột H.

Mong được sự giúp đỡ của các anh, chị, thầy, cô. ( Em xin phép đính kèm File đã lược bớt dữ liệu )

 

[bebo021999]

Đôi khi người ta phải lồng hàm COUNTIF vô code để tránh dùng vòng lặp ...
Nay bỏ COUNTIF thay bằng vòng lặp... Chưa chắc nhanh hơn dùng COUNTIF nha

Bài đã được tự động gộp: 22/3/23

Sau khi đếm xong thì cột H dùng để làm gì?
Nếu biết được mục đích thì có thể dùng code ra KQ luôn mà không cần dùng cột H chăng?

 

[kientung]

Đôi khi người ta phải lồng hàm COUNTIF vô code để tránh dùng vòng lặp ...
Nay bỏ COUNTIF thay bằng vòng lặp... Chưa chắc nhanh hơn dùng COUNTIF nha

Bài đã được tự động gộp: 22/3/23

Sau khi đếm xong thì cột H dùng để làm gì?
Nếu biết được mục đích thì có thể dùng code ra KQ luôn mà không cần dùng cột H chăng?

Sau khi đếm xong ở cột H, nếu lớn hơn 1 thì em sẽ ghép với cột G ạ

 

[bebo021999]

Rồi sao nữa? H và I chỉ là cột phụ thôi? Sau đó xóa đi?
Kết quả cuối cùng là cột G và số 2,3,...,n
Trimming Cleaning
Trimming Inspection
Trimming Cleaning 2
...
Đúng không?

 

[kientung]

Rồi sao nữa? H và I chỉ là cột phụ thôi? Sau đó xóa đi?
Kết quả cuối cùng là cột G và số 2,3,...,n
Trimming Cleaning
Trimming Inspection
Trimming Cleaning 2
...
Đúng không?

Dạ vâng. Đúng rồi ạ.

 

[BuiQuangThuan]

Thử sử dụng code này coi sao:

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, Key
    Application.ScreenUpdating = 0
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("A2:G" & .Range("A" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
    End With
    For i = 1 To UBound(sArr)
        Key = sArr(i, 1) & "|" & sArr(i, 7)
        If Dic.exists(Key) = False Then
            Dic.Add Key, 1
            Res(i, 1) = sArr(i, 7)
        Else
            Dic.Item(Key) = Dic.Item(Key) + 1
            Res(i, 1) = sArr(i, 7) & " " & Dic.Item(Key)
        End If
    Next
    Sheets("Sheet1").Range("J2").Resize(UBound(sArr), 1).Value = Res
    Application.ScreenUpdating = 1
End Sub

 

[bebo021999]

Xài đỡ cái này nhé:

Option Explicit
Sub test()
Dim lr&, i&, rng, res, id As String, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:G" & lr).Value
res = Range("G2:G" & lr).Value
For i = 1 To UBound(rng)
    id = rng(i, 1) & "|" & rng(i, 7)
    If Not dic.exists(id) Then
        dic.Add id, 1
    Else
        dic(id) = dic(id) + 1:        res(i, 1) = res(i, 1) & " " & dic(id)
    End If
Next
Range("G2:G" & lr).Value = res
End Sub

Bài đã được tự động gộp: 22/3/23

Thử sử dụng code này coi sao:

Tư tưởng lớn gặp nhau. Khác 1 chút là mình gán luôn cột G cho mảng res, và chỉ khi nào gặp trùng mới ghép số vào đuôi. (Có lẽ nhanh hơn 1 chút)

 

[kientung]

Xài đỡ cái này nhé:

Option Explicit
Sub test()
Dim lr&, i&, rng, res, id As String, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:G" & lr).Value
res = Range("G2:G" & lr).Value
For i = 1 To UBound(rng)
    id = rng(i, 1) & "|" & rng(i, 7)
    If Not dic.exists(id) Then
        dic.Add id, 1
    Else
        dic(id) = dic(id) + 1:        res(i, 1) = res(i, 1) & " " & dic(id)
    End If
Next
Range("G2:G" & lr).Value = res
End Sub

Bài đã được tự động gộp: 22/3/23

Tư tưởng lớn gặp nhau. Khác 1 chút là mình gán luôn cột G cho mảng res, và chỉ khi nào gặp trùng mới ghép số vào đuôi. (Có lẽ nhanh hơn 1 chút)

Em cảm ơn nhiều ạ.