Nối các ô dữ liệu có nhiều điều kiện (ví dụ: 2 điều kiện) (1 người xem)

[redevinte]

Gửi các anh chị em, nhờ anh chị em giúp giải vấn đề nối các ô dữ liệu với nhiều điều kiện (trong file ví dụ là 2 điều kiện). Tôi có tìm trên diễn đàn có bài nối dữ liệu theo một điều kiện bằng VBA nhưng do hiểu biết VBA kém nên không giải được bài trong ví dụ. Nhờ anh chị em xem chi tiết đề trong file gửi kèm và giúp đỡ.

 

[giangleloi]

Gửi các anh chị em, nhờ anh chị em giúp giải vấn đề nối các ô dữ liệu với nhiều điều kiện (trong file ví dụ là 2 điều kiện). Tôi có tìm trên diễn đàn có bài nối dữ liệu theo một điều kiện bằng VBA nhưng do hiểu biết VBA kém nên không giải được bài trong ví dụ. Nhờ anh chị em xem chi tiết đề trong file gửi kèm và giúp đỡ.

Bỏ code sau vào module rồi chạy thử xem sao nhé:

Sub GLL()
Dim Arr, vlArr(1 To 10000, 1 To 3), I , K
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet2
Arr = .Range(.[A3], .[C65000].End(3)).Value
End With
  For I = 1 To UBound(Arr, 1)
     Tem = Arr(I, 1) & "#" & Arr(I, 2)
       If Not Dic.exists(Tem) Then
         K = K + 1
         Dic.Add Tem, K
         vlArr(K, 1) = Arr(I, 1)
         vlArr(K, 2) = Arr(I, 2)
         vlArr(K, 3) = Arr(I, 3)
       Else
        vlArr(Dic.Item(Tem), 3) = vlArr(Dic.Item(Tem), 3) & " - " & Arr(I, 3)
      End If
  Next I
With Sheet1
 If K Then
   .[A3:C10000].ClearContents
   .[A3].Resize(K, 3) = vlArr
 End If
End With
Set Dic = Nothing
End Sub

 

[redevinte]

Bỏ code sau vào module rồi chạy thử xem sao nhé:

Sub GLL()
Dim Arr, vlArr(1 To 10000, 1 To 3), I , K
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet2
Arr = .Range(.[A3], .[C65000].End(3)).Value
End With
  For I = 1 To UBound(Arr, 1)
     Tem = Arr(I, 1) & "#" & Arr(I, 2)
       If Not Dic.exists(Tem) Then
         K = K + 1
         Dic.Add Tem, K
         vlArr(K, 1) = Arr(I, 1)
         vlArr(K, 2) = Arr(I, 2)
         vlArr(K, 3) = Arr(I, 3)
       Else
        vlArr(Dic.Item(Tem), 3) = vlArr(Dic.Item(Tem), 3) & " - " & Arr(I, 3)
      End If
  Next I
With Sheet1
 If K Then
   .[A3:C10000].ClearContents
   .[A3].Resize(K, 3) = vlArr
 End If
End With
Set Dic = Nothing
End Sub

Cảm ơn bạn đã giúp đỡ nhanh chóng. Tôi chạy thử code của bạn thì kết quả giống như mong muốn. Bạn có thể chuyển thành công thức (hàm tự tạo) để áp dụng tổng quát được không?

 

[Ba Tê]

Cảm ơn bạn đã giúp đỡ nhanh chóng. Tôi chạy thử code của bạn thì kết quả giống như mong muốn. Bạn có thể chuyển thành công thức (hàm tự tạo) để áp dụng tổng quát được không?

Hàm tự tạo đây..............

 

[redevinte]

Hàm tự tạo đây..............

Công thức tốt rồi nhưng có một rằng buộc là "vùng điều kiện" và "vùng dữ liệu chứa điều kiện" các cột phải đặt cạnh nhau và các cột này phải xếp cùng thứ tự (tất nhiên là kể cả công thức của Microsoft tạo ra trên Excel vẫn có những rằng buộc khó tránh khỏi). Trong trường hợp này vẫn muốn nhờ bạn cải tiến nếu có thể được (cũng do muốn học tập thêm), để công thức được tiện dụng hơn.
Ví dụ:
"=GPE(join_range, criteria_range1, criteria1, criteria_range2, criteria2,...)"
Giống kiểu công thức SUMIFS