DÒ TÌM MÃ SẢN PHẨM VỚI ĐIỀU KIỆN THEO VÙNG

[MrBao69]

Hi all,
Em có file bên dưới, giờ em căn cứ vào mã sản phẩm và tỉnh (Bảng dò) để lấy mức giá đầu tư 60đ/ sp (cột E của bảng data), có cách nào dùng VBA dò dc không mọi người?
1/ Bảng 1 là bảng data


2/ Bảng dò


Trân trọng cám ơn!

 

[MrBao69]

Có ai giúp tôi với

 

[Nhattanktnn]

Có ai giúp tôi với

Thử code :

Option Explicit
Sub GiaDauTu()
Dim ArrLookup(), ArrVal(), Res, I&, J&, Rw&, Col&
With Sheets("Sheet2")
    ArrLookup = .Range("A2:E" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    Rw = UBound(ArrLookup, 1)
    Col = .Cells(1, Columns.Count).End(xlToLeft).Column
    If Col < 11 Then Exit Sub
    ArrVal = .Range(.Cells(1, "K"), .Cells(2, Col)).Value
    ReDim Res(1 To UBound(ArrVal, 2))
    For I = 1 To UBound(ArrVal, 2)
        For J = 1 To Rw
            If InStr(1, ArrVal(2, I), ArrLookup(J, 1), 1) And InStr(1, ArrVal(1, I), ArrLookup(J, 2), 1) Then
                Res(I) = ArrLookup(J, 5)
                Exit For
            End If
        Next
    Next
    .Range("K3").Resize(1, Columns.Count - 10).ClearContents
    .Range("K3").Resize(1, UBound(ArrVal, 2)) = Res
End With
End Sub

 

[MrBao69]

Thử code :

Option Explicit
Sub GiaDauTu()
Dim ArrLookup(), ArrVal(), Res, I&, J&, Rw&, Col&
With Sheets("Sheet2")
    ArrLookup = .Range("A2:E" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    Rw = UBound(ArrLookup, 1)
    Col = .Cells(1, Columns.Count).End(xlToLeft).Column
    If Col < 11 Then Exit Sub
    ArrVal = .Range(.Cells(1, "K"), .Cells(2, Col)).Value
    ReDim Res(1 To UBound(ArrVal, 2))
    For I = 1 To UBound(ArrVal, 2)
        For J = 1 To Rw
            If InStr(1, ArrVal(2, I), ArrLookup(J, 1), 1) And InStr(1, ArrVal(1, I), ArrLookup(J, 2), 1) Then
                Res(I) = ArrLookup(J, 5)
                Exit For
            End If
        Next
    Next
    .Range("K3").Resize(1, Columns.Count - 10).ClearContents
    .Range("K3").Resize(1, UBound(ArrVal, 2)) = Res
End With
End Sub

Mình đã chạy code nhưng không ra kết quả? sau khi chạy code xóa đơn giá bên bảng dò á.

 

[BuiQuangThuan]

Mình đã chạy code nhưng không ra kết quả? sau khi chạy code xóa đơn giá bên bảng dò á.

Bạn chỉ có 1 đơn giá 60 thôi à

 

[HUONGLIEN6577]

Có ai giúp tôi với

Thủ dùng thử code này xem có đáp ứng được không?
Hãy thay đổi hoặc thêm dữ liệu và chạy thử.

 

[MrBao69]

Thủ dùng thử code này xem có đáp ứng được không?
Hãy thay đổi hoặc thêm dữ liệu và chạy thử.

Bạn thân mến,
-Bạn có thể xóa vùng (K6:M27) để cho file nó gọn ko ạ
-Chạy code ổn nhưng em thấy là sản phẩm I ở thị trường Kiêng Giang hoặc Cà mau thì ko tham chiếu đc đơn giá ạ,
Mình chỉnh vòng lặp "For i = 11 To 17" thì nó chạy đủ ạ, Tuy nhiên nếu thêm sản phẩm khác thì phải chỉnh tay. cái này chỉnh cho For i = 11 To 100 chắc ổn hihi
Cám ơn bạn giúp đỡ và quan tâm.

 

[HUONGLIEN6577]

Bạn thân mến,
-Bạn có thể xóa vùng (K6:M27) để cho file nó gọn ko ạ
-Chạy code ổn nhưng em thấy là sản phẩm I ở thị trường Kiêng Giang hoặc Cà mau thì ko tham chiếu đc đơn giá ạ,
Mình chỉnh vòng lặp "For i = 11 To 17" thì nó chạy đủ ạ, Tuy nhiên nếu thêm sản phẩm khác thì phải chỉnh tay. cái này chỉnh cho For i = 11 To 100 chắc ổn hihi
Cám ơn bạn giúp đỡ và quan tâm.

Thêm dòng tô đậm vào đúng chỗ bạn nhé.
With Sheet6
k = .[J1].End(xlToRight).Column ' lấy cột cuối có sản phẩm
For i = 11 To k
từ những lần chay code sau bạn có thêm sản phẩm nhiều hay ít tùy ý

Vùng K6:M27 là vùng tạm của mảng Arr. Dùng VBA để xóa. Thêm dong tô đậm vào code nhé

Next i
.[E2].Resize(UBound(ArrD), 1) = ArrN
.[K6].Resize(t, 3).ClearContents
End With

Chúc bạn vui và thành công

 

[MrBao69]

Thêm dòng tô đậm vào đúng chỗ bạn nhé.
With Sheet6
k = .[J1].End(xlToRight).Column ' lấy cột cuối có sản phẩm
For i = 11 To k
từ những lần chay code sau bạn có thêm sản phẩm nhiều hay ít tùy ý

Vùng K6:M27 là vùng tạm của mảng Arr. Dùng VBA để xóa. Thêm dong tô đậm vào code nhé

Next i
.[E2].Resize(UBound(ArrD), 1) = ArrN
.[K6].Resize(t, 3).ClearContents
End With

Chúc bạn vui và thành công

Hi bạn,

Đoạn code mình thấy nó nhấp nháy màn hình
Mình góp ý thêm 2 đoạn code:
Application.ScreenUpdating = False
Application.ScreenUpdating = True

Cám ơn bạn nhiều nhé.

 

[HUONGLIEN6577]

Hi bạn,

Đoạn code mình thấy nó nhấp nháy màn hình
Mình góp ý thêm 2 đoạn code:
Application.ScreenUpdating = False
Application.ScreenUpdating = True

Cám ơn bạn nhiều nhé.

Do máy của mình chạy êm nên mình không đưa vào, thứ nữa là mình biết bạn có thể làm được.
nếu trang tính của bạn nhiều công thức hay tắt chức năng tính toán tự động (điều này chắc chắn là bạn biết) thì code cũng có thể chạy nhanh hơn.