Dò tìm giảm giá bằng VBA

[thao nguyen01]

Kính gửi anh/chị trên diễn đàn,

Em đang bị vướng vấn đề sau ạ:

Em muốn dò tìm cột giảm giá trong sheet Danh muc: Nếu ngày bên sheet Thống kê nằm trong khoảng ngày của Danh mục thì sẽ lấy cột Giảm giá ạ. Em có viết code nhưng chưa ra ạ. Anh/chị xem giúp em ạ. Em cảm ơn nhiều ạ.

Sub thongke03(Dic As Object, arr_D())
Dim i As Long, dcuoi As Long
Dim arr_N()
dcuoi = Sheet2.Range("G10000").End(xlUp).Row
arr_N = Sheet2.Range("G2:I" & dcuoi)
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 3)
For i = 1 To UBound(arr_N, 1)
If Not Dic.exists(">=" & arr_N(i, 1) And "<=" & arr_N(i, 2)) Then
k = k + 1
Dic.Add ">=" & arr_N(i, 1) And "<=" & arr_N(i, 2), k
arr_D(k, 1) = arr_N(i, 1)
arr_D(k, 2) = arr_N(i, 2)
arr_D(k, 3) = arr_N(i, 3)
End If
Next
End Sub


Sub dotim()
Dim i As Long, dcuoi As Long, j As Long, ii As Long
Dim arr_N()
Dim arr_D(), arr_Dotim()
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Call thongke03(Dic, arr_Dotim)

dcuoi = Sheet1.Range("C10000").End(xlUp).Row
arr_N = Sheet1.Range("C2:C" & dcuoi)
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 2)

For i = 1 To UBound(arr_N, 1)
If Dic.exists(arr_N(i, 1)) Then
j = Dic.Item(arr_N(i, 1))
arr_D(i, 1) = arr_Dotim(j, 3)
End If
Next
Sheet1.Range("G2:H1000").Clear
Sheet1.Range("G2").Resize(UBound(arr_N, 1), 1) = arr_D
End Sub

 

[Ba Tê]

Dạ, con xin lỗi ạ. Con gửi Bác file đính kèm ạ, trong file con có mô tả ạ. Vùng màu xanh là kết quả ạ. Bác xem giúp con ạ. Con cảm ơn Bác.

Bài này đâu làm theo kiểu bài trên được.
Viết Code cũng phải dò như VlookUp() thôi

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), tArr()
Dim I As Long, J As Long, R As Long, R2 As Long
    tArr = Range("G2:J8").Value
    R2 = UBound(tArr)
    sArr = Range("B2", Range("B2").End(xlDown)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    For J = R2 To 1 Step -1
        If sArr(I, 1) >= tArr(J, 1) Then
            dArr(I, 1) = tArr(J, 3)
            dArr(I, 2) = tArr(J, 4)
            dArr(I, 3) = sArr(I, 1) * dArr(I, 1) - dArr(I, 2)
            Exit For
        End If
    Next J
Next I
Range("C2").Resize(R, 3) = dArr
End Sub

 

[thao nguyen01]

Bài này đâu làm theo kiểu bài trên được.
Viết Code cũng phải dò như VlookUp() thôi

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), tArr()
Dim I As Long, J As Long, R As Long, R2 As Long
    tArr = Range("G2:J8").Value
    R2 = UBound(tArr)
    sArr = Range("B2", Range("B2").End(xlDown)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    For J = R2 To 1 Step -1
        If sArr(I, 1) >= tArr(J, 1) Then
            dArr(I, 1) = tArr(J, 3)
            dArr(I, 2) = tArr(J, 4)
            dArr(I, 3) = sArr(I, 1) * dArr(I, 1) - dArr(I, 2)
            Exit For
        End If
    Next J
Next I
Range("C2").Resize(R, 3) = dArr
End Sub

Dạ, con cảm ơn bác @Ba Tê nhiều ạ. Code ra đúng ạ.^^. Nhưng Bác có thể giải thích giúp con là bài này tại sao không thể áp dụng code bài #16 ạ. Vì con thấy cũng dò trong khoảng từ..... đến... ạ. Con chưa hiểu lắm ạ

 

[Ba Tê]

Dạ, con cảm ơn bác @Ba Tê nhiều ạ. Code ra đúng ạ.^^. Nhưng Bác có thể giải thích giúp con là bài này tại sao không thể áp dụng code bài #16 ạ. Vì con thấy cũng dò trong khoảng từ..... đến... ạ. Con chưa hiểu lắm ạ

Bài kia trong khoảng tối đa 365 ngày, đưa vào Dic.
Bài này trong khoảng từ 0 đến ... "mút chỉ", mảng nào chịu nổi.

 

[thao nguyen01]

Bài kia trong khoảng tối đa 365 ngày, đưa vào Dic.
Bài này trong khoảng từ 0 đến ... "mút chỉ", mảng nào chịu nổi.

Dạ, con hiểu rồi ạ. Con cảm ơn Bác nhiều lắm ạ.