
Gửi bởi
QuocDung2510
------------------------------
Chọn đủ chỉ tiêu của 1 loại là đúng còn xét hết A thì mới xét B,C,D thì ko đúng
Xét theo ưu tiên; xét hết ưu tiên 1 của A,B,C,D nếu vẫn chưa đủ của loại nào thì xét tiếp ưu tiên 2 của các loại đó và tiếp đến 3,4 nếu vẫn chưa đủ
đây là câu bạn phải nói ngay từ #1 . chạy Sub này
Mã:
Public Sub hello()
Dim arr As Variant, lr As Long, dicMA As Object, dicThamChieu As Object, arrThamChieu As Variant, r As Long
Dim dArr As Variant
With Sheet1
lr = .Range("E1000000").End(xlUp).Row
If lr > 1 Then
Application.ScreenUpdating = False
.Range("A2:F" & lr).Sort key1:=.[C2], order1:=xlAscending, key2:=.[D2], order2:=xlAscending, _
key3:=.[E2], order3:=xlDescending
arr = .Range("A2:E" & lr).Value
ReDim dArr(1 To UBound(arr), 1 To 1)
Set dicMA = CreateObject("Scripting.Dictionary")
Set dicThamChieu = CreateObject("Scripting.Dictionary")
arrThamChieu = .Range("L3:N" & .[N2].End(xlDown).Row).Value
For r = 1 To UBound(arrThamChieu) Step 1
dicThamChieu.Add arrThamChieu(r, 1), Array(arrThamChieu(r, 2), arrThamChieu(r, 3), 0)
Next
For r = 1 To UBound(arr) Step 1
If Not dicMA.exists(arr(r, 2)) And dicThamChieu.exists(arr(r, 4)) Then
If arr(r, 5) > dicThamChieu(arr(r, 4))(0) Then
If dicThamChieu(arr(r, 4))(2) < dicThamChieu(arr(r, 4))(1) Then
dArr(r, 1) = True
arrThamChieu = dicThamChieu(arr(r, 4))
arrThamChieu(2) = arrThamChieu(2) + 1
dicThamChieu(arr(r, 4)) = arrThamChieu
dicMA(arr(r, 2)) = 1
End If
End If
End If
Next
.Range("F2:F" & lr).Value = dArr
.Range("A2:F" & lr).Sort key1:=.[A2], order1:=xlAscending
Application.ScreenUpdating = True
End If
End With
End Sub