Nhờ các Anh chị viết macro giải quyết bài toán xét nhiều điều kiện

[noithat889]

.Xlsm là hỗ trợ chạy macro thì phải

[hgk.vn]

file bài #1 thì bảng tham chiếu nằm ở cột L-> N
file thật nằm ở M->O . sao đỡ ?
file bài #1 đặt tên là sheet1
file thật đặt tên là Trang Tính . sao đỡ ?

đổi tên shêt kia thành "TrangTinh" rồi chạy sub này

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 Worksheets("TrangTinh")
    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("M3:O" & .[O2].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

[manhhuong]

file bài #1 thì bảng tham chiếu nằm ở cột L-> N
file thật nằm ở M->O . sao đỡ ?
file bài #1 đặt tên là sheet1
file thật đặt tên là Trang Tính . sao đỡ ?

đổi tên shêt kia thành "TrangTinh" rồi chạy sub này


<div class="bbcode_container">
<div class="bbcode_description">Code:

</div>
</div>
----------------------
Đang chạy thử nhưng có vẻ kết quả đúng rồi!
Cảm ơn Bác nhiều!

[quoctiepkt]

File đã chạy
Mình Bổ sung thêm yêu cầu vào file xét trên Nhờ Bác giải quyết giúp
Vì dữ liệu trong vùng A:E liên tục được nhập vào trong nhiều ngày; Mình muốn mỗi ngày xét 1 lần và khi xét xong thì khóa dữ liệu True đã xét của từng mã và xét tiếp thì chỉ xét các dữ liệu mới được nhập và những mã chưa có True ở cả 4 row. bảng tham chiếu của ngày hôm sau có thể khác của ngày hôm trước.

[duongphungbds]

Tôi có nói gì đâu mà bạn bảo là tôi hiểu nhầm ý bạn.
Tôi chỉ giả lập dữ liệu, Code là code trong file mà bạn tải lên ở bài #27. Tôi hỏi là vì nếu như với dữ liệu đó sẽ có kết quả khác tốt hơn (A chọn các dòng có STT 9, 11, 13, 15, 17; B chọn các dòng có STT 2, 4, 6, 8)

-----------------------------------------------
vấn đề này em có nói đến trong bài trên rồi bác ạ; vấn đề là ở chỗ cột ưu tiên đó và cái này bác doveandrose đã giải quyết được rồi!
Còn file ở bài #27 là xét thêm lần 2 sau khi cập nhật thêm dữ liệu bác nhé!

[sangame]

----------------------------------
Đúng nếu hết chỉ tiêu thì dù có tốt hơn cung coi như false và sẽ được xét ở lần tiếp theo nếu cả 4 row của mã đều false

bạn mới trả lời có 1 trong 2 câu thì sao tôi làm ?

[vlvietlamvl]

bạn mới trả lời có 1 trong 2 câu thì sao tôi làm ?

----------
1. khi thêm dòng mới vào bảng A->F mà có giá trị tốt làm cho các giá trị đã xét True trước đó rơi khỏi Top tốt nhất thì sao ?
----> True lần xét 1 rồi thì không xét lại nên không quan tâm nó có thuộc top hay không.
2. vẫn giữ True như cũ thì các dòng mới không có quyền xét True vì hết chỉ tiêu mặc dù tốt hơn ? ---> Chính xác
3. hôm nay mức giá trị Min loại A để là 15 ngày mai sửa lên thành 25 thì mấy dòng cũ vẫn tính là True ? ----> Chính xác
Để kiểm tra lại cái này có thể bổ sung thêm 1 colum ghi lại giá trị xét True đó là trong lần xét 1,2,3,4,5,n bên cạnh colum True

[huongcao]

code chỉ nhận 1 bảng tham chiếu là vùngM->P thôi nhé . muốn thay đổi gì thì sửa trực tiếp lên bảng tham chiếu
bạn vào ô P3 gõ công thức , không phải là đếm cho vui đâu ,code có xài đến cột P

=COUNTIFS($D$2:$D$1000000,M3,$F$2:$F$1000000,TRUE)

kéo công thức xuống hết bảng tham chiếu


chạy sub này

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 Worksheets("TrangTinh")
    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:F" & lr).Value
        ReDim dArr(1 To UBound(arr), 1 To 1)
        Set dicMA = CreateObject("Scripting.Dictionary")
        Set dicThamChieu = CreateObject("Scripting.Dictionary")
        arrThamChieu = .Range("M3:P" & .[M2].End(xlDown).Row).Value
        For r = 1 To UBound(arrThamChieu) Step 1
            dicThamChieu.Add arrThamChieu(r, 1), Array(arrThamChieu(r, 2), arrThamChieu(r, 3), arrThamChieu(r, 4))
        Next
        
        For r = 1 To UBound(arr) Step 1
            dArr(r, 1) = arr(r, 6)
            If arr(r, 6) = True Then dicMA(arr(r, 2)) = 1
        Next
        
        For r = 1 To UBound(arr) Step 1
            If arr(r, 6) <> True Then
                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
            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

[vytieubao]

đánh giá True dựa vào bảng tham chiếu . thay đổi bảng tham chiếu mà lại giữ nguyên các dòng True trước đó là sao ?
hôm nay loại A lấy 10 chỉ tiêu . ngày mai sửa bảng tham chiếu xuống còn 3 chỉ tiêu , mà vẫn giữ nguyên các dòng True trước đó rồi la làng code cho kết quả sai ?

[ngoalongsong]

đánh giá True dựa vào bảng tham chiếu . thay đổi bảng tham chiếu mà lại giữ nguyên các dòng True trước đó là sao ?
hôm nay loại A lấy 10 chỉ tiêu . ngày mai sửa bảng tham chiếu xuống còn 3 chỉ tiêu , mà vẫn giữ nguyên các dòng True trước đó rồi la làng code cho kết quả sai ?

------------------------------------------------
Cột chỉ tiêu thì sẽ không đổi; Cột giá trị min của từng loại sẽ thay đổi; và dữ liệu đã được xét True(Mã được true) trước thì cũng không đổi khi xét lần tiếp theo
Vì bài toán xét của em la nếu chưa đủ chỉ tiêu có thể sẽ hạ mức giá trị xuống cho phù hợp (Không phải là hạ để đủ True ngay trong 1 lần xét mà hạ hoặc tăng giá trị nếu ngày hôm sau dữ liệu được nhập vào có nhiều giá trị lớn)
----> có thể hiểu đơn giản là e có khoảng 20 bảng tham chiếu; Và khi xét lần 1 với bảng tham chiếu 1 và lần 2 với bảng tham chiếu 2 nhưng vẫn giữ kết quả của đã xét theo bảng 1 (theo mã của các trường hợp True) còn False thì sẽ xét lại
Bác xem file đính kèm giúp em