Tìm tên trong bảng và copy theo hàng ngang (1 người xem)

[loinguyen212]

Xin chào mọi người.
Em có bài toán như vậy. trong sheet2 sẽ tìm đúng tên và copy cả 4 cột (Cl1,Cl2,Cl3,Cl4) từ sheet1 sang, nếu tìm thấy nhiều tên lặp lại thì copy vào các cột tiếp theo (hàng ngang). Em thử viết vòng lặp mà chưa được, xin mọi người giúp đỡ.

 

[concogia]

Xin chào mọi người.
Em có bài toán như vậy. trong sheet2 sẽ tìm đúng tên và copy cả 4 cột (Cl1,Cl2,Cl3,Cl4) từ sheet1 sang, nếu tìm thấy nhiều tên lặp lại thì copy vào các cột tiếp theo (hàng ngang). Em thử viết vòng lặp mà chưa được, xin mọi người giúp đỡ.

Sao lại phải tìm đúng tên trong sheet 2 mà không cho code chạy tìm trong sheet1, những em nào trùng thì gom chúng vào hàng ngang rồi ghi kết quả vào sheet 2 luôn nhỉ ???

 

[loinguyen212]

Sao lại phải tìm đúng tên trong sheet 2 mà không cho code chạy tìm trong sheet1, những em nào trùng thì gom chúng vào hàng ngang rồi ghi kết quả vào sheet 2 luôn nhỉ ???

vâng như thế cũng được ạ. Ví như danh sách ở sheet2 dài hơn (có chứa tên mà trong sheet1 lại không có). Nên em mới đưa ra như vậy. Em nghĩ cả trưa nay mà chưa làm được.

 

[concogia]

vâng như thế cũng được ạ. Ví như danh sách ở sheet2 dài hơn (có chứa tên mà trong sheet1 lại không có). Nên em mới đưa ra như vậy. Em nghĩ cả trưa nay mà chưa làm được.

Đây là code lấy hết:

Public Sub LungTung()
    Dim Vung, I, J, K, kK, Kq, d, iMax
        Set d = CreateObject("scripting.dictionary")
        Vung = Sheets("sheet1").Range(Sheets("sheet1").[C5], Sheets("sheet1").[C50000].End(xlUp)).Resize(, 7)
        ReDim Kq(1 To UBound(Vung), 1 To UBound(Vung) * 4)
            For I = 1 To UBound(Vung)
                If Not d.exists(Vung(I, 1)) Then
                    K = K + 1
                    d.Add Vung(I, 1), K
                    Kq(K, 1) = Vung(I, 1)
                        For J = 2 To 5
                            Kq(K, J) = Vung(I, J + 2)
                        Next J
                    Kq(K, UBound(Kq, 2)) = 1
                 Else
                    kK = d.Item(Vung(I, 1))
                    For J = 2 To 5
                        Kq(kK, J + Kq(kK, UBound(Kq, 2)) * 4) = Vung(I, J + 2)
                    Next J
                        Kq(kK, UBound(Kq, 2)) = Kq(kK, UBound(Kq, 2)) + 1
                        iMax = IIf(iMax >= Kq(kK, UBound(Kq, 2)), iMax, Kq(kK, UBound(Kq, 2)))
                 End If
            Next I
    Sheets("sheet2").[B6].Resize(K, iMax * 4 + 1) = Kq
End Sub

Còn nếu muốn thêm điều kiện dò bên sheet1 thì bạn tự sửa code tý tẹo xem sao nhé
Thân

 

[loinguyen212]

Đây là code lấy hết

Cảm ơn bác đã giúp đỡ. Bác cho em hỏi trong này có mấy chỗ em chưa hiểu, bác giải thích giúp em:
1. Set d
2. If not d.exists
em đọc code chậm lắm, mà chưa biết gì nhiều, mong bác giúp đỡ. Thân

 

[concogia]

Cảm ơn bác đã giúp đỡ. Bác cho em hỏi trong này có mấy chỗ em chưa hiểu, bác giải thích giúp em:
1. Set d
2. If not d.exists
em đọc code chậm lắm, mà chưa biết gì nhiều, mong bác giúp đỡ. Thân

Bạn hãy tìm các bài về Dictionary đọc nhé, trên diễn đàn cả đống
Thân

 

[loinguyen212]

Về Dictionary (cho bạn nào đang đọc bài này mà cũng chưa biết như mình, đỡ đi tìm) http://www.giaiphapexcel.com/forum/showthread.php?60643-Tổng-quan-về-Scripting-Dictionary
Bác CoGia cho em hỏi:
1. phần bác khai báo lại biến Kq có *4. vậy chỗ này khai báo thế máy sẽ hiểu như thế nào ạ?
2. chỗ này em không hiểu

Kq(K, UBound(Kq, 2)) = 1

Thân!

 

[concogia]

Về Dictionary (cho bạn nào đang đọc bài này mà cũng chưa biết như mình, đỡ đi tìm) http://www.giaiphapexcel.com/forum/showthread.php?60643-Tổng-quan-về-Scripting-Dictionary
Bác CoGia cho em hỏi:
1. phần bác khai báo lại biến Kq có *4. vậy chỗ này khai báo thế máy sẽ hiểu như thế nào ạ?
2. chỗ này em không hiểu

Kq(K, UBound(Kq, 2)) = 1

Thân!

Vì không biết chính xác bảng kết quả sẽ có bao nhiêu hàng & cột nên khi khai báo số dòng & cột của biến Kq thì:
1) Số dòng của biến Kq tối đa bằng số dòng của dữ liệu gốc
Dữ liệu gốc để lấy có 4 cột Cl1; Cl2; Cl3; Cl4
2) Số cột của biến Kq tối đa bằng số dòng của dữ liệu gốc "nhân" 4 "cộng" 1

Kq(K, UBound(Kq, 2)) = 1

Cứ mỗi lần dữ liệu gốc trùng thì dữ liệu gán vào biến Kq tăng lên 4 ( dù có đủ hay không có đủ dữ liệu), mình gán vào biến Kq, cột tận cùng bên phải ( Kq(K, UBound(Kq, 2)) )để khi chạy xong code tính được số cột thực tế của biến Kq

Sheets("sheet2").[B6].Resize(K, iMax * 4 + 1) = Kq

Số dòng thực tế bằng giá trị của biến K hay d.keys.count
Số cột thực tế bằng biến iMax * 4 + 1
Cứ từ từ sẽ.........hiểu
Thân

 

[loinguyen212]

Còn nếu muốn thêm điều kiện dò bên sheet1 thì bạn tự sửa code tý tẹo xem sao nhé

Em nghĩ qua đến giờ mà không tài nào sửa được (do biết về VBA chưa nhiều), mong bác chỉ cách để em học tập. Thân!

 

[concogia]

Em nghĩ qua đến giờ mà không tài nào sửa được (do biết về VBA chưa nhiều), mong bác chỉ cách để em học tập. Thân!

Đại khái là thế này:

Public Sub LungTungXeng()
    Dim Vung, I, J, K, kK, Kq, d, iMax, Dk, Wf
        Set Wf = Application.WorksheetFunction
        Set Dk = Sheets("sheet2").Range(Sheets("sheet2").[B6], Sheets("sheet2").[B6].End(xlDown))
        Set d = CreateObject("scripting.dictionary")
        Vung = Sheets("sheet1").Range(Sheets("sheet1").[C5], Sheets("sheet1").[C50000].End(xlUp)).Resize(, 7)
        Kq = Sheets("sheet2").Range(Sheets("sheet2").[B6], Sheets("sheet2").[B6].End(xlDown)).Resize(, UBound(Vung) * 4)
            For I = 1 To UBound(Vung)
                If Wf.CountIf(Dk, Vung(I, 1)) Then
                    If Not d.exists(Vung(I, 1)) Then
                        K = Wf.Match(Vung(I, 1), Dk, 0)
                        d.Add Vung(I, 1), K
                            For J = 2 To 5
                                Kq(K, J) = Vung(I, J + 2)
                            Next J
                        Kq(K, UBound(Kq, 2)) = 1
                     Else
                        kK = d.Item(Vung(I, 1))
                        For J = 2 To 5
                            Kq(kK, J + Kq(kK, UBound(Kq, 2)) * 4) = Vung(I, J + 2)
                        Next J
                            Kq(kK, UBound(Kq, 2)) = Kq(kK, UBound(Kq, 2)) + 1
                            iMax = IIf(iMax >= Kq(kK, UBound(Kq, 2)), iMax, Kq(kK, UBound(Kq, 2)))
                     End If
                End If
            Next I
    Sheets("sheet2").[B6].Resize(UBound(Kq), iMax * 4 + 1) = Kq
End Sub

Bạn thay đổi thứ tự & thêm bớt dữ liệu bảng kết quả ở Sheet2 rồi chạy code kiểm tra xem sao
Mình chưa thử hết các trường hợp, có gì nói sau
Thân