Giúp đỡ về Compare Range với vòng For

[hadoan-pap]

Chào mọi người!

Mong mọi người giúp đỡ về 1 bài toán nho nhỏ của em ạ.

Em có 2 sheet dữ lieu ( sheet1, sheet2 ) trong file. Sheet2 sẽ được tham chiếu dữ lieu từ sheet1... file that bên ngoài của em dữ lieu rất nhiều ( cột và hang lên đến vài nghin ) nên khai báo thông thường dung vòng For thì code chạy rất nặng, nên rất mong mọi ng hỗ trợ giúp em dung Range.

2 sheet có item " mã hang " đc sử dung để làm tham chiếu. Sheet2 sẽ tham chiếu kết quả từ sheet1 dựa trên mã hang. Sheet1 nó sẽ chạy từ hang 11 đến hang 22, tìm xem chỗ nào có text là " Total CD ", " Total CU " thì sẽ đồng bộ sang sheet 2 cột D và F dựa trên " mã hang "

File gôc dữ lieu hang cột rất nhiều nên bắt buộc phải dung Range hay mảng để làm vòng lặp ạ... E lại k có nh kiến thức để làm cái này.

Rất mong nhận đc sự giúp đỡ. Em xin cảm ơn!

 

[CHAOQUAY]

Gửi bạn.

Mình đã chạy thử code bạn.

Code bạn nó tham chiếu rồi tạo lại các trường từ sheet1 sang sheet2. Ý mình khác 1 chút là các trường trong Sheet 2 là cố định rồi, nó chỉ tham chiếu từ Sheet1 sang các giá trị của Total CU và Total CD theo mã hang bạn ạ.

Bạn có thể sửa lại giúp mình đc k? Mình đang tham khảo 1 số cách các bạn làm để học them nên giúp mình nhé.
Vậy thì bạn thử code này
Cảm ơn bạn.

Sub Filter_Transpose()
Dim SArr As Variant
Dim DArr As Variant
Dim Res As Variant
Dim i As Long, j As Long
Dim RowCD, RowCU
SArr = Sheet1.UsedRange
ReDim Res(1 To UBound(SArr, 2), 1 To 3)
Res(1, 1) = "ma hang"
Res(1, 2) = "CD"
Res(1, 3) = "CU"
For i = 1 To UBound(SArr)
    If SArr(i, 1) = "Total CD" Then RowCD = i
    If SArr(i, 1) = "Total CU" Then RowCU = i
Next i
With CreateObject("Scripting.Dictionary")
    DArr = Sheet2.Range("a3", Sheet2.Range("a3").End(xlDown))
    For i = 1 To UBound(DArr)
        .Item(DArr(i, 1)) = ""
    Next i
    i = 1
    For j = 2 To UBound(SArr, 2)
        If .exists(SArr(1, j)) Then
            i = i + 1
            Res(i, 1) = SArr(1, j)
            Res(i, 2) = SArr(RowCD, j)
            Res(i, 3) = SArr(RowCU, j)
        End If
    Next j
End With
Sheet2.Range("a8").Resize(i, UBound(Res, 2)) = Res
End Sub

 

[hadoan-pap]

Sub Filter_Transpose()
Dim SArr As Variant
Dim DArr As Variant
Dim Res As Variant
Dim i As Long, j As Long
Dim RowCD, RowCU
SArr = Sheet1.UsedRange
ReDim Res(1 To UBound(SArr, 2), 1 To 3)
Res(1, 1) = "ma hang"
Res(1, 2) = "CD"
Res(1, 3) = "CU"
For i = 1 To UBound(SArr)
    If SArr(i, 1) = "Total CD" Then RowCD = i
    If SArr(i, 1) = "Total CU" Then RowCU = i
Next i
With CreateObject("Scripting.Dictionary")
    DArr = Sheet2.Range("a3", Sheet2.Range("a3").End(xlDown))
    For i = 1 To UBound(DArr)
        .Item(DArr(i, 1)) = ""
    Next i
    i = 1
    For j = 2 To UBound(SArr, 2)
        If .exists(SArr(1, j)) Then
            i = i + 1
            Res(i, 1) = SArr(1, j)
            Res(i, 2) = SArr(RowCD, j)
            Res(i, 3) = SArr(RowCU, j)
        End If
    Next j
End With
Sheet2.Range("a8").Resize(i, UBound(Res, 2)) = Res
End Sub

Cảm ơn bạn nhé