Sửa code tạo danh sách theo điều kiện

[biboylenka1]

Em xin chào tất cả các anh/chị trong diễn đàn!
Hiện tại em đang tạo một file theo dõi văn phòng phẩm.
Trong sheet "AOP" là định mức văn phòng phẩm từ các bộ phận gửi về em đã tổng hợp lại.
Từ sheet "AOP" em muốn tạo một danh sách văn phòng phẩm theo 2 điều kiện là bộ phận và tháng rồi gán xuống sheet "Nhap".
Em đã vẽ được 1 userform để tạo danh sách. Nhưng em tự viết code thấy lủng củng và dùng nhiều "if" quá.
Em xin nhờ anh chị sửa hoặc viết lại đoạn code giúp em cho tối ưu.
Hoặc nếu thấy em bố trí bảng tính chưa hợp lý nhờ anh chị chỉ em cách bố trí lại dữ liệu sao cho khoa học ạ.

 

[SA_DQ]

Bạn thử với con macro này & mong sẽ hữu ích với bạn xíu nào đó:

Private Sub Cbt_nhap_Click()
    Dim arrData():                              Dim BF As String
    Dim I As Integer, K As Integer, A As Integer, B As Integer, C As Integer, lR As Long
  
    On Error GoTo LoiCT     
        Sheet1.ShowAllData
'    On Error GoTo 0            '
    lR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    arrData = Sheet1.Range("A7:CR" & lR).Value
    If Cbx_bophan.Text = "" Then
        MsgBox "Chua Chon Bo Fan":             Exit Sub
    End If
    BF = Cbx_bophan.Text
    A = Switch(BF = "HR-PUR-BOD", 0, BF = "ACC", 1, BF = "WH", 2, BF = "MP", 3, _
        BF = "QA", 4, BF = "UP", 5, BF = "MTN", 6)
    If Not IsNumeric(Cbx_thang) Then
        MsgBox "Phai Nhâp Tháng Là Sô Tù 1 Dên 12"
        Cbx_thang.Text = "GPE.COM":             Exit Sub
    End If
    If Cbx_thang.Text = "" Then
        MsgBox "Chua Chon Tháng"
        Exit Sub
    End If
    B = Choose(Cbx_thang.Value, 13, 20, 27, 34, 41, 48, 55, 62, 69, 76, 83, 90)
    C = A + B
    ReDim arrRes(1 To UBound(arrData), 1 To 4)
    For I = 1 To UBound(arrData)
        If arrData(I, C) <> "" Then
            K = K + 1
            arrRes(K, 1) = arrData(I, 3):       arrRes(K, 2) = arrData(I, 4)
            arrRes(K, 3) = arrData(I, 5):       arrRes(K, 4) = arrData(I, C)
        End If
    Next I
    If K = 0 Then
        MsgBox "Bô Phân " & Cbx_bophan.Text & " Trong Tháng " & Cbx_thang.Text & _
            " Không Có Dinh Muc AOP"
        Exit Sub
    End If
'    On Error Resume Next   '
        Sheet3.ShowAllData
'    On Error GoTo 0        '
    lR = Sheet3.Range("C" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    If lR < 5 Then
        Sheet3.Range("C6").Resize(K, 4) = arrRes
    Else
        Sheet3.Range("C" & lR + 1).Resize(K, 4) = arrRes
    End If
    Application.ScreenUpdating = True

    MsgBox "Xong: Da Nhâp Dinh Múc AOP Tháng " & Cbx_thang.Text & " Cua Bô Phân " & _
        Cbx_bophan & Chr(10) & Space(13) & " Vào Dòng " & lR + 1 & " Dên Dòng " & lR + K
    Unload Me
Err_:           Exit Sub
LoiCT:
    If Err = 1004 Then
        Resume Next
    Else
        MsgBox Error:           GoTo Err_
    End If
End Sub

 

[HUONGHCKT]

Em xin chào tất cả các anh/chị trong diễn đàn!
Hiện tại em đang tạo một file theo dõi văn phòng phẩm.
Trong sheet "AOP" là định mức văn phòng phẩm từ các bộ phận gửi về em đã tổng hợp lại.
Từ sheet "AOP" em muốn tạo một danh sách văn phòng phẩm theo 2 điều kiện là bộ phận và tháng rồi gán xuống sheet "Nhap".
Em đã vẽ được 1 userform để tạo danh sách. Nhưng em tự viết code thấy lủng củng và dùng nhiều "if" quá.
Em xin nhờ anh chị sửa hoặc viết lại đoạn code giúp em cho tối ưu.
Hoặc nếu thấy em bố trí bảng tính chưa hợp lý nhờ anh chị chỉ em cách bố trí lại dữ liệu sao cho khoa học ạ.

mạo muội sửa code cho bạn. có sai sót gì xin được góp ý chứ đừng ném đá
Phần bố trí kết cấu của trang tính (không dám góp vô)

Private Sub UserForm_Initialize()
    Cbx_bophan.List = Sheet2.Range("J7:J13").Value
    Cbx_thang.List = Sheet2.Range("N7:N18").Value
End Sub
Private Sub Cbt_nhap_Click()
    Dim arrData()
    Dim i As Integer
    Dim k As Integer
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim lr As Long
    
    On Error Resume Next
        Sheet1.ShowAllData
    On Error GoTo 0
    
    lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    arrData = Sheet1.Range("A7:CR" & lr).Value
    
    If Cbx_bophan.Text = "" Then
        MsgBox "Chua chon bo phan"
        Exit Sub
    End If
'    If Cbx_bophan.Text = "HR" Then a = 0
'    If Cbx_bophan.Text = "ACC" Then a = 1
'    If Cbx_bophan.Text = "WH" Then a = 2
'    If Cbx_bophan.Text = "MP" Then a = 3
'    If Cbx_bophan.Text = "QA" Then a = 4
'    If Cbx_bophan.Text = "UP" Then a = 5
'    If Cbx_bophan.Text = "MTN" Then a = 6
    Bophan = Array(HR, ACC, WH, MP, QA, UP, MTN) 'dua vao mang
For i = 0 To UBound(Bophan)                      ' chay vong lap tim bo phan
    If Bophan(i) = Cbx_bophan.Text Then a = 1
Next i
    If Not IsNumeric(Cbx_thang) Then
        MsgBox "Phai nhap thang la so tu 1 den 12"
        Cbx_thang.Text = ""
        Exit Sub
    End If
    If Cbx_thang.Text = "" Then
        MsgBox "chua chon thang"
        Exit Sub
    End If
   Thang = Array(, 13, 20, 27, 34, 41, 48, 55, 62, 69, 76, 83, 90) ' dua vao mang
   b = Thang(Cbx_thang.Text)
'    If Cbx_thang.Text = 1 Then b = 13
'    If Cbx_thang.Text = 2 Then b = 20
'    If Cbx_thang.Text = 3 Then b = 27
'    If Cbx_thang.Text = 4 Then b = 34
'    If Cbx_thang.Text = 5 Then b = 41
'    If Cbx_thang.Text = 6 Then b = 48
'    If Cbx_thang.Text = 7 Then b = 55
'    If Cbx_thang.Text = 5 Then b = 62
'    If Cbx_thang.Text = 9 Then b = 69
'    If Cbx_thang.Text = 10 Then b = 76
'    If Cbx_thang.Text = 11 Then b = 83
'    If Cbx_thang.Text = 12 Then b = 90
    
    c = a + b
    
    ReDim arrRes(1 To UBound(arrData), 1 To 5)
    
    For i = 1 To UBound(arrData)
        If arrData(i, c) <> "" Then
            k = k + 1
            arrRes(k, 1) = Cbx_bophan.Text    ' them bo phan vao cho de theo doi va nhu vay thi redim arrRes cung phai thay
            arrRes(k, 2) = arrData(i, 3)
            arrRes(k, 3) = arrData(i, 4)
            arrRes(k, 4) = arrData(i, 5)
            arrRes(k, 5) = arrData(i, c)
        End If
    Next i
    
    If k = 0 Then
        MsgBox "Bo phan " & Cbx_bophan.Text & " trong thang " & Cbx_thang.Text & " khong co dinh muc AOP"
        Exit Sub
    End If
    
    On Error Resume Next
        Sheet3.ShowAllData
    On Error GoTo 0
    lr = Sheet3.Range("B" & Rows.Count).End(xlUp).Row

    Application.ScreenUpdating = False
    If lr < 5 Then
        Sheet3.Range("B6").Resize(k, 5) = arrRes      ' thay doi vi tri gan ket qua
    Else
        Sheet3.Range("B" & lr + 1).Resize(k, 5) = arrRes
    End If
    Application.ScreenUpdating = True

    MsgBox "Xong: Da nhap dinh muc AOP thang " & Cbx_thang.Text & " cua bo phan " & Cbx_bophan & " vao dong " & lr + 1 & " den dong " & lr + k
    Unload Me
End Sub

 

[biboylenka1]

Bạn thử với con macro này & mong sẽ hữu ích với bạn xíu nào đó:

Cháu cảm ơn chú nhé, nếu có gì không hiểu cháu sẽ hỏi lại ạ.

mạo muội sửa code cho bạn. có sai sót gì xin được góp ý chứ đừng ném đá
Phần bố trí kết cấu của trang tính (không dám góp vô)

Em cảm ơn anh đã quan tâm, em sẽ xem lại code có gì em sẽ hỏi lại. Em hỏi phần bố trí trang tính là tại lúc viết code em chưa nghĩ ra cách nào ngoài liệt kê tất cả ra cả nên mới nhờ mọi người xem giúp là có phải là em bố trí trang tính chưa hợp lý không.

 

[biboylenka1]

mạo muội sửa code cho bạn. có sai sót gì xin được góp ý chứ đừng ném đá

Bophan = Array(HR, ACC, WH, MP, QA, UP, MTN) 'dua vao mang
For i = 0 To UBound(Bophan) ' chay vong lap tim bo phan
If Bophan(i) = Cbx_bophan.Text Then a = 1
Next i

Đoạn này do chắc do code ban đầu của em sai nên anh cũng viết sai theo (nhưng tình cờ vẫn ra kết quả đúng ).
Em sửa lại như sau:

Bophan = Array("HR-PUR-BOD", "ACC", "WH", "MP", "QA", "UP", "MTN") 'dua vao mang
For i = 0 To UBound(Bophan)                      ' chay vong lap tim bo phan
    If Bophan(i) = Cbx_bophan.Text Then
        a = i
        Exit For
    End If
Next i

Bài đã được tự động gộp: 20/1/22

Bạn thử với con macro này & mong sẽ hữu ích với bạn xíu nào đó:

Cháu cảm ơn chú, cháu lại biết thêm một cách nữa!

 

[SA_DQ]

Câu lệnh ở #2:
B = Choose(Cbx_thang.Value, 13, 20, 27, 34, 41, 48, 55, 62, 69, 76, 83, 90)
Có thể viết dưới dạng:
7 * Cbx_thang.Value + 6

Chúc mọi người vui vẻ!

 

[biboylenka1]

Câu lệnh ở #2:
B = Choose(Cbx_thang.Value, 13, 20, 27, 34, 41, 48, 55, 62, 69, 76, 83, 90)
Có thể viết dưới dạng:
7 * Cbx_thang.Value + 6

Đúng là từ đầu cháu định viết dạng như thế này mà cả buổi chiều không nghĩ ra quy luật, nên cháu đành liệt kê tất cả ra .