Góc hỏi file chạy chiết khấu khuyến mại 1-3 lần trong tháng với nhiều mã hàng nhiều giá cho nhiều nhà cung cấp

[Huong2019]

Chào Anh Chị. Em có 1 đề bài là hàng tháng chạy chương trình trên giá gốc 1,2 hoặc 3 lần chạy chương trình theo % từng mã hàng của từng nhà cung cấp. ra giá khuyến mãi. nếu hàng nào không chạy khuyến mại thì áp lại giá gốc. Giờ em muốn là với từng đơn hàng xuất đi giá ứng với mã hàng với nhà cung cấp giá của thời điểm chạy chiết khấu đó ạ.
Với nhiều dữ liệu hơn nữa file sẽ rất nặng. FIle này của em có thể dùng VBA để viết giúp giảm nhẹ file được không ạ. Rất mong các anh chị giúp đỡ ạ. Em cảm ơn ạ

 

[HUONGHCKT]

Chào Anh Chị. Em có 1 đề bài là hàng tháng chạy chương trình trên giá gốc 1,2 hoặc 3 lần chạy chương trình theo % từng mã hàng của từng nhà cung cấp. ra giá khuyến mãi. nếu hàng nào không chạy khuyến mại thì áp lại giá gốc. Giờ em muốn là với từng đơn hàng xuất đi giá ứng với mã hàng với nhà cung cấp giá của thời điểm chạy chiết khấu đó ạ.
Với nhiều dữ liệu hơn nữa file sẽ rất nặng. FIle này của em có thể dùng VBA để viết giúp giảm nhẹ file được không ạ. Rất mong các anh chị giúp đỡ ạ. Em cảm ơn ạ

Bạn giải thích
1/Trong Sh XuatKho ở Ô W9 có mã nhà cung cấp = h và l nhưng tại sao trong Sh data dòng AK3:BB3 không có tên các nhà cung cấp này?
2/Và trong dòng AK3:BB3 có tận 2 nhà cung cấp tên f (AP3=f và AS3=f) và 2 nhà cung cấp tên d (AN3=d và AR3=d)?

Nếu trùng như vậy thì lấy ở cột nào?

 

[Huong2019]

Bạn giải thích
1/Trong Sh XuatKho ở Ô W9 có mã nhà cung cấp = h và l nhưng tại sao trong Sh data dòng AK3:BB3 không có tên các nhà cung cấp này?
2/Và trong dòng AK3:BB3 có tận 2 nhà cung cấp tên f (AP3=f và AS3=f) và 2 nhà cung cấp tên d (AN3=d và AR3=d)?

Nếu trùng như vậy thì lấy ở cột nào?

Dạ . Tại do em đổi dữ liệu gốc sang dữ liệu hỏi bị sai ạ. Em xin gửi lại file ạ

 

[HUONGHCKT]

Dạ . Tại do em đổi dữ liệu gốc sang dữ liệu hỏi bị sai ạ. Em xin gửi lại file ạ

File bạn up lên vẫn có chỗ chưa đúng. mã khách hàng là B và b và C và c có giống nhau không?Ở Sh xuat kho có ma khách hàng tên b và c nhưng bên sh data không có. tôi đã sửa lại là C và B và cột mã khách hàng của Sh xuất kho cũng đã được tôi giả định lại.
Bạn xem file. Kết quả trả về tôi đang để ở Cột AA
Để áp dụng cho mỗi lần điều chỉnh giá sẽ không làm thay đổi giá đã xác định của những lần trước: Những dòng của Sh xuat kho có ngày (cột E) không nằm trong khoảng từ ngày (ô A1 /Sh Data) đến ngày ( ô B1/Sh Data) và nhỏ hơn ngày (ô A1/Sh Data) sẽ được giữ nguyên giá của lần điều chỉnh lần trước ( DÒNG TÔ MÀU HỒNG); Những dòng có ngày lớn hơn ngày ở ô (B1/Sh Data) sẽ không được xét(DÒNG TÔ MÀU CAM); Dòng có ngày năm trong khoảng (Ô A1 đến ô B1/Sh Data) sẽ được tìm ỏ Sh data và gán vào).
Bạn hãy thử thay đổi dữ liệu ( ngày tháng xuất kho, ngày tháng áp dụng điều chỉnh giá, khách hàng, mã hàng ..... ) và nhấn nút để xem và kiểm tra lại kết quả.

PS: tự cảm nhận code chưa thật gọn và tối ưu, anh chị em nào có ghé qua xem code và cho góp ý để hoàn thiện hơn. Trân trọng

Sub XYZ()
Dim i&, j&, R&, C&, Lr&
Dim Arr(), KQ()
Dim Dic As Object
Dim ngaydau, ngaycuoi
Set Sh = Sheets("data")
Lr = Sh.Cells(Rows.Count, 36).End(xlUp).Row
Arr = Sh.Range("AJ3:BB" & Lr).Value
R = UBound(Arr, 1): C = UBound(Arr, 2)
ngaydau = Sh.Cells(1, 1): ngaycuoi = Sh.Cells(1, 2)
Lr1 = Sheets("xuat kho").Cells(Rows.Count, 14).End(xlUp).Row
Arr1 = Sheets("xuat kho").Range("E3:AA" & Lr1).Value
R1 = UBound(Arr1, 1)
ReDim KQ(1 To R1, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To C
   If Not Dic.exists(Arr(1, i)) Then t = t + 1: Dic.Add (Arr(1, i)), t
Next i
For i = 1 To R1
    If Arr1(i, 1) < ngaydau Then KQ(i, 1) = Arr1(i, 23)
    If Arr1(i, 1) > ngaycuoi Then KQ(i, 1) = "Không xet"

    If Arr1(i, 1) >= ngaydau And Arr1(i, 1) <= ngaycuoi Then
        If Arr1(i, 22) <> 0 Then
            For j = 1 To R
                    If Arr1(i, 10) = Arr(j, 1) Then
                        Temp = Arr1(i, 19)
                        If Dic.exists(Temp) Then KQ(i, 1) = Arr(j, Dic.Item(Temp))
                    End If
            Next j
        End If
        End If
Next i
Sheets("xuat kho").Range("AB3").Resize(i, 1).ClearContents
Sheets("xuat kho").Range("AB3").Resize(i, 1) = KQ
Set Dic = Nothing
MsgBox " xong"
End Sub