Xuất dữ liệu từ điều kiện, thông tin ở 2 sheet ra nhiều sheet (1 người xem)

[stao]

Chào các Bác,

Em đang tìm hiểu về Scripting Dictionary. Bài tập đính kèm đã hỏi trên GPE nhưng còn vướng một chút là Data 2 có nhiều hơn 1 cột cần truy xuất thông tin thì chưa biết cách làm code thế nào.

1. Data1: id là điều kiện để liên kết với Data2, guest là điều kiện để liên quan sheet
2. Data2: từ id có thêm nhiều thông tin chi tiết liên quan
3. Các sheet (Alpha, Beta, Delta): Được đổ dữ liệu theo điều kiện guest từ 2 sheet Data 1 và 2
4. Sheet gama: Các guest còn lại sẽ đổ vào đây

Nhờ các Bác hướng dẫn giúp. Xin cảm ơn nhiều.

 

[stao]

Add vào Dic cái ID tại Data2 này. -> Vì cơ bản dữ liệu tại Data2 này đã là duy nhất cái ID rồi.
Ví dụ

For I = 1 To UBound(ArrData2)
       Dic.Item(ArrData2(I, 1)) = I
Next

Sau đó muốn truy xuất giá trị các cột ở Data2 thì thông qua ID đã add vào Dic
Ví dụ

If Dic.exists(ArrData1(I, 1)) Then
      sArr(K, 3) = ArrData2(Dic.Item(ArrData1(I, 1)), 3)
Else
      sArr(K, 3) = Empty
End If

Ghi chú: code của bạn còn luộm thuộm và dài dòng quá -> nên rút gọn lại.

Cảm ơn Bác. Em đã làm được. Vì mới tiếp cận Scripting Dictionary này nên cũng chưa rành cách hoạt động của nó lắm.
Khi chỉnh code theo ý Bác thì file chạy chậm chút. Cũng chưa rõ phải rút gọn code sau nữa. Nếu Bác có thời gian thì nhờ Bác giúp ạ

 

[Ba Tê]

Cảm ơn Bác. Em đã làm được. Vì mới tiếp cận Scripting Dictionary này nên cũng chưa rành cách hoạt động của nó lắm.
Khi chỉnh code theo ý Bác thì file chạy chậm chút. Cũng chưa rõ phải rút gọn code sau nữa. Nếu Bác có thời gian thì nhờ Bác giúp ạ

Rút gọn một chút:

Public Sub GPE()
Dim Dic As Object, ArrData1(), ArrData2(), Tmp(), Txt As String, ShName As String
Dim I As Long, J As Long, K As Long, N As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
'------------------------------------Gan Id ArrData2 vao Dic'
    Tmp = Range("J1:M2").Value
    ArrData1 = Sheets("Data1").Range("A5", Sheets("Data1").Range("A5").End(xlDown)).Resize(, 6).Value
    R = UBound(ArrData1)
    ArrData2 = Sheets("Data2").Range("A5").Resize(R, 4).Value
    For I = 1 To UBound(ArrData2)
        Dic.Item(ArrData2(I, 1)) = I
    Next I
'---------------------------------------Lay du lieu cho 3 sheet dieu kien J2:L2 (A,B,C)'
For N = 1 To 3
    ReDim dArr(1 To R, 1 To 7)
    ShName = Tmp(1, N)
    Txt = Tmp(2, N)
    K = 0
    For I = 1 To R
        If ArrData1(I, 6) = Txt Then
            K = K + 1
            dArr(K, 1) = ArrData1(I, 1)
            dArr(K, 2) = ArrData1(I, 2)
            dArr(K, 4) = "GPE"
            dArr(K, 5) = ArrData1(I, 3)
            dArr(K, 6) = ArrData1(I, 5)
            ArrData1(I, 6) = Empty  '-------------------Xoa guest A,B,C'
            If Dic.Exists(ArrData1(I, 1)) Then
                Rws = Dic.Item(ArrData1(I, 1))
                dArr(K, 3) = ArrData2(Rws, 3)
                dArr(K, 7) = ArrData2(Rws, 4)
            End If
        End If
    Next I
    Sheets(ShName).Range("A5").Resize(100, 7).ClearContents
    If K Then Sheets(ShName).Range("A5").Resize(K, 7) = dArr
Next N
'---------------------------------------Lay du lieu cho sheet dieu kien M2 (Khac)'
ReDim dArr(1 To R, 1 To 7)
ShName = Tmp(1, 4)
K = 0
For I = 1 To R
    If ArrData1(I, 6) <> Empty Then 'Lay guest con lai'
        K = K + 1
            dArr(K, 1) = ArrData1(I, 1)
            dArr(K, 2) = ArrData1(I, 2)
            dArr(K, 4) = "GPE"
            dArr(K, 5) = ArrData1(I, 3)
            dArr(K, 6) = ArrData1(I, 5)
        If Dic.Exists(ArrData1(I, 1)) Then
            Rws = Dic.Item(ArrData1(I, 1))
            dArr(K, 3) = ArrData2(Rws, 3)
            dArr(K, 7) = ArrData2(Rws, 4)
        End If
    End If
Next I
With Sheets(ShName)
    .Range("A5").Resize(100, 7).ClearContents
    If K Then .Range("A5").Resize(K, 7) = dArr
End With
Set Dic = Nothing
End Sub

 

[stao]

Cảm ơn hai Bác, em đã chạy thử. Kết quả ngon lành ạ.

 

[tonnydung]

Em chào cả nhà. Các bác bớt chút thời gian giúp em cái Form sửa và nhập dữ liệu này với ah. Em có gửi File kèm theo. Em cảm ơn các bác nhiều

 

[be_09]

Em chào cả nhà. Các bác bớt chút thời gian giúp em cái Form sửa và nhập dữ liệu này với ah. Em có gửi File kèm theo. Em cảm ơn các bác nhiều

Bạn vi phạm nội quy 2 vấn đề sau:
1/ Tiêu đề của chủ Topic là "Xuất dữ liệu từ điều kiện, thông tin ở 2 sheet ra nhiều sheet" đâu có liên quan gì đến cái vụ UserForm mà bạn lại chen ngang.
2/ Không nên đăng cùng nội dung với nhiều bài viết ở nhiều nơi, bài 145 của bạn ở Link sau:
https://www.giaiphapexcel.com/diendan/threads/các-câu-hỏi-về-form-trong-excel-vba.58794/page-8

 

[tonnydung]

Bạn vi phạm nội quy 2 vấn đề sau:
1/ Tiêu đề của chủ Topic là "Xuất dữ liệu từ điều kiện, thông tin ở 2 sheet ra nhiều sheet" đâu có liên quan gì đến cái vụ UserForm mà bạn lại chen ngang.
2/ Không nên đăng cùng nội dung với nhiều bài viết ở nhiều nơi, bài 145 của bạn ở Link sau:
https://www.giaiphapexcel.com/diendan/threads/các-câu-hỏi-về-form-trong-excel-vba.58794/page-8

Vâng em đăng nhầm. Bác qua bên này xem và giúp em với ah. Tks bác : https://www.giaiphapexcel.com/diendan/threads/các-câu-hỏi-về-form-trong-excel-vba.58794/page-8