Nhờ giúp đỡ lọc kế hoạch tuần.

hml89 · 17/5/21

Kính gửi anh,chị,em trong diễn đàn.
Em có làm kế hoạch theo tuần để in ra, nhưng em loay hoay mấy bữa nay mà chưa làm được.
Có 2 vấn đề em đang chưa xử lý được là :
- code chưa chạy ra kết quả
- sau khi có kết quả, em có ghi 1 Macro để sort theo cột kết thúc. Vậy cho em hỏi là cái sort này làm sao để cho vào cùng 1 sub lọc bên trên? hay là mình phải ghi 2 sub riêng biệt ạ.
Em xin cám ơn!

ptm0412 · 17/5/21

Arr lấy từ B, k tính từ A thì làm sao so khớp được k và cột chứa dữ liệu mong muốn.
Ngoài ra, tại sao lại Redim Preserve và phải Transpose?

Maika8008 · 17/5/21

hml89 đã viết:
Kính gửi anh,chị,em trong diễn đàn.
Em có làm kế hoạch theo tuần để in ra, nhưng em loay hoay mấy bữa nay mà chưa làm được.
Có 2 vấn đề em đang chưa xử lý được là :
- code chưa chạy ra kết quả
- sau khi có kết quả, em có ghi 1 Macro để sort theo cột kết thúc. Vậy cho em hỏi là cái sort này làm sao để cho vào cùng 1 sub lọc bên trên? hay là mình phải ghi 2 sub riêng biệt ạ.
Em xin cám ơn!

Chắc chắn code sẽ không bao giờ cho kết quả vì

Với câu lệnh sau:
If Arr(i, k) < 1 And Arr(i, k - 1) > 1 Then
tôi không biết bạn muốn so sánh 1 (1 là gì?) với cột gì trong mảng? Vì theo logic các câu lệnh trước thì Arr(i, k) hoặc Arr(i, k - 1) là các cột ngày tháng!

Con số 1 so với ngày tháng thì không suy ra được ý định của bạn?

ptm0412 · 17/5/21

Maika8008 đã viết:
Chắc chắn code sẽ không bao giờ cho kết quả vì

Có ra kết quả, nếu sửa Arr = Sheet1.Range("A6:R" & dc)

Tuy nhiên còn nhiều cái sai lắm

Maika8008 · 17/5/21

ptm0412 đã viết:
Có ra kết quả, nếu sửa Arr = Sheet1.Range("A6:R" & dc)

View attachment 258831

Tuy nhiên còn nhiều cái sai lắm

Hihi, tôi biết rồi. So với 1 thay cho điều kiện có ngày phát sinh hay không

hml89 · 17/5/21

Maika8008 đã viết:
Chắc chắn code sẽ không bao giờ cho kết quả vì

Với câu lệnh sau:
If Arr(i, k) < 1 And Arr(i, k - 1) > 1 Then
tôi không biết bạn muốn so sánh 1 (1 là gì?) với cột gì trong mảng? Vì theo logic các câu lệnh trước thì Arr(i, k) hoặc Arr(i, k - 1) là các cột ngày tháng!

Con số 1 so với ngày tháng thì không suy ra được ý định của bạn?

Mình đang mong muốn làm kế hoạch theo từng công đoạn để in ra.
*) Công đoạn là sheet1 dòng 3.
*) Tiếp là công đoạn cắt và công đoạn đóng gói : điều kiện 1: Nếu cột kết thúc < 1 và Cột bắt đầu > 1.
điều kiện 2: cột bắt đầu có số tuần = sheet2 ô F2
=> sau đó sẽ sao chép kết quả tìm được sang sheet 2.
*) Công đoạn Dũa và Bao
Điều kiện 1: Nếu thực hiện < 1 và kết thúc >1
Điều kiện 2: Kết thúc có số tuần là điều kiện tìm ở sheet2 ô F2
=> sau đó sao chép kết quả như ô mẫu.
Trên đây là diễn giải mong muốn của mình.
Sơ sơ là mình muốn lọc kế hoạch của từng tổ , theo tuần . Nếu các cột kết thúc/ thực hiện đều chưa có ghi chép ngày tháng gì và cột k-1 có ngày tháng theo đúng điều kiện tuần là sheet2 ô F2 thì sẽ lấy kết quả.
Do các cột tên của mình hơn lộn xộn, nên mình có dùng match để lấy k và k-1. Để làm cho điều kiện 1

Bài đã được tự động gộp: 17/5/21

ptm0412 đã viết:
Có ra kết quả, nếu sửa Arr = Sheet1.Range("A6:R" & dc)

View attachment 258831

Tuy nhiên còn nhiều cái sai lắm

Thầy ơi, em buồn quá. Làm mãi mà không có được.

ptm0412 · 17/5/21

hml89 đã viết:
Thầy ơi, em buồn quá. Làm mãi mà không có được.

Thử làm lại:
- Arr lấy từ A
- ArrBC làm bình thường đừng có xoay ngang rồi phải xoay dọc (Transpose) lại
- Lấy tờ giấy ra ghi hết các cột dữ liệu số mấy tương ứng những cột báo cáo số mấy
- Lặp bình thường, gán giá trị đúng cột vào ArrBC
- Xoá kết quả cũ (xoá dư đi, xoá 50 dòng chẳng hạn, đừng chỉ xoá cố định 5, 6, 7 dòng của kết quả)
- Gán kết quả xuống
- Đóng khung
- Sort

ptm0412 · 17/5/21

Ví dụ ghi ra giấy như sau:

1. Kết quả cột B => khi xong gán xuống B
2. Data bắt đầu cột B: k phải tính match từ B chứ không match từ A nữa:
k = WorksheetFunction.Match(ToDoi, Sheet1.Range("B3:BB3"), 0)
3. Bắt đầu và kết thúc nằm ở vị trí k -2 và k - 1 chứ không phải k - 1 và k

Maika8008 · 17/5/21

hml89 đã viết:
Mình đang mong muốn làm kế hoạch theo từng công đoạn để in ra.
*) Công đoạn là sheet1 dòng 3.
*) Tiếp là công đoạn cắt và công đoạn đóng gói : điều kiện 1: Nếu cột kết thúc < 1 và Cột bắt đầu > 1.
điều kiện 2: cột bắt đầu có số tuần = sheet2 ô F2
=> sau đó sẽ sao chép kết quả tìm được sang sheet 2.
*) Công đoạn Dũa và Bao
Điều kiện 1: Nếu thực hiện < 1 và kết thúc >1
Điều kiện 2: Kết thúc có số tuần là điều kiện tìm ở sheet2 ô F2
=> sau đó sao chép kết quả như ô mẫu.
Trên đây là diễn giải mong muốn của mình.
Sơ sơ là mình muốn lọc kế hoạch của từng tổ , theo tuần . Nếu các cột kết thúc/ thực hiện đều chưa có ghi chép ngày tháng gì và cột k-1 có ngày tháng theo đúng điều kiện tuần là sheet2 ô F2 thì sẽ lấy kết quả.
Do các cột tên của mình hơn lộn xộn, nên mình có dùng match để lấy k và k-1. Để làm cho điều kiện 1

Bài đã được tự động gộp: 17/5/21

Thầy ơi, em buồn quá. Làm mãi mà không có được.

Bạn dùng code tôi sửa (các tham chiếu cột trong mảng) của bạn nè, bạn dò từng dòng sẽ thấy bạn sai ở đâu. Kết quả ra đã phù hợp 100% mong muốn của bạn.

Rich (BB code):

Dim dc As Long, k As Long, n As Long, dcBC As Long, i As Long, j As Long, wn&
On Error Resume Next
ToDoi = LCase(Sheet2.Range("C2").Value)
dc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
Arr = Sheet1.Range("B6:R" & dc)
k = WorksheetFunction.Match(ToDoi, Sheet1.Range("3:3"), 0)
For i = 1 To UBound(Arr, 1)
wn = WorksheetFunction.WeekNum(Format(Arr(i, k - 2), "mm/dd"))
    If Arr(i, k - 2) > 1 And Arr(i, k - 1) < 1 And wn = Sheet2.Cells(2, "F").Value Then
'        If wn Like "*" & Sheet2.Cells(2, "F").Value & "*" Then
'        If wn = Sheet2.Cells(2, "F").Value Then
        'CLng(Arr(i, k)) <> CLng(Arr(i, k - 1)) And
            n = n + 1
            ReDim Preserve ArrBC(1 To 6, 1 To n)
            For j = 1 To 4
                ArrBC(j, n) = Arr(i, j)
            Next
            ArrBC(5, n) = Format(Arr(i, k - 3), "mm/dd")
            ArrBC(6, n) = Format(Arr(i, k - 2), "mm/dd")
            'ArrBC(11, n) = Format(Arr(i, k + 1), "mm/dd")
        End If
    
Next
With Sheet2
    dcBC = .Range("B" & Rows.Count).End(xlUp).Row
    If dcBC < 6 Then dcBC = 6
'    .Range("B7").Resize(dcBC, 6).Borders.LineStyle = xlNone
'    .Range("B7").Resize(dcBC, 6).ClearContents
    .Range("B7").Resize(n, 6) = Application.Transpose(ArrBC)
'    .Range("B7").Resize(n, 6).Borders.LineStyle = xlContinuous
'    .Range("B7").Resize(n, 6).Borders(xlInsideHorizontal).Weight = xlHairline
End With
End Sub

hml89 · 17/5/21

Maika8008 đã viết:

Bạn dùng code tôi sửa (các tham chiếu cột trong mảng) của bạn nè, bạn dò từng dòng sẽ thấy bạn sai ở đâu. Kết quả ra đã phù hợp 100% mong muốn của bạn.

Rich (BB code):

Dim dc As Long, k As Long, n As Long, dcBC As Long, i As Long, j As Long, wn&
On Error Resume Next
ToDoi = LCase(Sheet2.Range("C2").Value)
dc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
Arr = Sheet1.Range("B6:R" & dc)
k = WorksheetFunction.Match(ToDoi, Sheet1.Range("3:3"), 0)
For i = 1 To UBound(Arr, 1)
wn = WorksheetFunction.WeekNum(Format(Arr(i, k - 2), "mm/dd"))
    If Arr(i, k - 2) > 1 And Arr(i, k - 1) < 1 And wn = Sheet2.Cells(2, "F").Value Then
'        If wn Like "*" & Sheet2.Cells(2, "F").Value & "*" Then
'        If wn = Sheet2.Cells(2, "F").Value Then
        'CLng(Arr(i, k)) <> CLng(Arr(i, k - 1)) And
            n = n + 1
            ReDim Preserve ArrBC(1 To 6, 1 To n)
            For j = 1 To 4
                ArrBC(j, n) = Arr(i, j)
            Next
            ArrBC(5, n) = Format(Arr(i, k - 3), "mm/dd")
            ArrBC(6, n) = Format(Arr(i, k - 2), "mm/dd")
            'ArrBC(11, n) = Format(Arr(i, k + 1), "mm/dd")
        End If
   
Next
With Sheet2
    dcBC = .Range("B" & Rows.Count).End(xlUp).Row
    If dcBC < 6 Then dcBC = 6
'    .Range("B7").Resize(dcBC, 6).Borders.LineStyle = xlNone
'    .Range("B7").Resize(dcBC, 6).ClearContents
    .Range("B7").Resize(n, 6) = Application.Transpose(ArrBC)
'    .Range("B7").Resize(n, 6).Borders.LineStyle = xlContinuous
'    .Range("B7").Resize(n, 6).Borders(xlInsideHorizontal).Weight = xlHairline
End With
End Sub

Cám ơn bạn @Maika8008 nhiều ạ. Mình sẽ F8 lại từng dòng để tìm ra lỗi sai trong code của mình, sau khi tìm ra mình sẽ báo lại bạn. Bạn ơi cho mình hỏi chút là mình có record macro để sort kết quả, lấy sort theo cột G là cột kết thúc, vậy là như nào để gộp nó vào trong sub mà không phải làm 1 sub khác ạ?

Bài đã được tự động gộp: 17/5/21

ptm0412 đã viết:
Thử làm lại:
- Arr lấy từ A
- ArrBC làm bình thường đừng có xoay ngang rồi phải xoay dọc (Transpose) lại
- Lấy tờ giấy ra ghi hết các cột dữ liệu số mấy tương ứng những cột báo cáo số mấy
- Lặp bình thường, gán giá trị đúng cột vào ArrBC
- Xoá kết quả cũ (xoá dư đi, xoá 50 dòng chẳng hạn, đừng chỉ xoá cố định 5, 6, 7 dòng của kết quả)
- Gán kết quả xuống
- Đóng khung
- Sort

Vâng ạ, em cám ơn Thầy, em sẽ luyện tập lại.

Maika8008 · 17/5/21

hml89 đã viết:
Cám ơn bạn @Maika8008 nhiều ạ. Mình sẽ F8 lại từng dòng để tìm ra lỗi sai trong code của mình, sau khi tìm ra mình sẽ báo lại bạn. Bạn ơi cho mình hỏi chút là mình có record macro để sort kết quả, lấy sort theo cột G là cột kết thúc, vậy là như nào để gộp nó vào trong sub mà không phải làm 1 sub khác ạ?

Bạn thêm dòng này vào trước End With gần cuối Sub:
.Range("B6:G" & .Range("B65536").End(xlUp).Row).Sort Key1:=.Range("G6"), Order1:=xlAscending, Header:=xlYes

hml89 · 17/5/21

Maika8008 đã viết:
Bạn thêm dòng này vào trước End With gần cuối Sub:
.Range("B6:G" & .Range("B65536").End(xlUp).Row).Sort Key1:=.Range("G6"), Order1:=xlAscending, Header:=xlYes

Bạn ơi, cho mình hỏi chút.

Là cái ô H2 ấy. Ban đầu mình nghĩ là xác định k, nên nếu dùng code trên thì k nó sẽ là cột H (cắt), cột L (Dũa), cột P (bao), cột R ( đóng gói). Do vậy, ví dụ nếu lấy điều kiện tuần ở cột G thì sau cột H nó sẽ là K-1. Mình đang nghĩ là mình bị xác định sai k, mà vẫn chưa hiểu rõ nó như nào.

Maika8008 · 17/5/21

hml89 đã viết:
Bạn ơi, cho mình hỏi chút.View attachment 258837
Là cái ô H2 ấy. Ban đầu mình nghĩ là xác định k, nên nếu dùng code trên thì k nó sẽ là cột H (cắt), cột L (Dũa), cột P (bao), cột R ( đóng gói). Do vậy, ví dụ nếu lấy điều kiện tuần ở cột G thì sau cột H nó sẽ là K-1. Mình đang nghĩ là mình bị xác định sai k, mà vẫn chưa hiểu rõ nó như nào.

Thực tôi chẳng biết ý định của bạn thế nào: CẮT và ĐÓNG GÓI thì nằm ngay cột Kết thúc nhưng DŨA và BAO thì lại nằm ở cột Thực hiện? Và cũng không biết tại sao cột thực hiện lại trống rỗng dể cho bạn dùng nó làm điều kiện để lấy dữ liệu trong vòng lặp?

Nhưng dù thế nào thì bạn tham chiếu bị lệch 1 cột khiến bạn bối rối. Bạn lấy k theo hàm WorksheetFunction nên nó bảo là 16 nhưng khi xác định cột trong mảng thì nó chỉ là cột 15. Lẽ ra bạn chú ý đến tác giả bài #4 có nói: Arr = Sheet1.Range("A6:R" & dc). Nếu bạn đặt như thế thì bạn sẽ đỡ đau đầu nhiều!
@!>><

Giả sử Arr = Sheet1.Range("A6:R" & dc) thì câu lệnh If Arr(i, k - 2) > 1 And Arr(i, k - 1) sẽ thành If Arr(i, k - 1) > 1 And Arr(i, k ) < 1

ptm0412 · 17/5/21

hml89 đã viết:
Mình đang nghĩ là mình bị xác định sai k, mà vẫn chưa hiểu rõ nó như nào.

k tính bằng Match (3:3) ra 16, tức là 16 kể từ A = cột P
nhưng k đưa vào truy xuất Arr (i, 16) tức là 16 kể từ B, do Arr lấy dữ liệu từ B => cột Q

Code sau đây đơn giản, bỏ hết hàm format đi.

PHP:

Sub kehoachTuan()
Dim Arr, ArrBC(), ToDoi As String
Dim dc As Long, k As Long, n As Long, dcBC As Long, i As Long, j As Long, wn
On Error Resume Next
ToDoi = Sheet2.Range("C2").Value
dc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
Arr = Sheet1.Range("B6:R" & dc).Value
k = WorksheetFunction.Match(ToDoi, Sheet1.Range("B3:BB3"), 0)
n = 0
ReDim ArrBC(1 To 50, 1 To 7)
For i = 1 To UBound(Arr, 1)
wn = WorksheetFunction.WeekNum(Arr(i, k - 1))
    If Arr(i, k) < 1 And Arr(i, k - 1) > 1 Then
        If wn = Sheet2.Cells(2, "F").Value Then
            n = n + 1
            ArrBC(n, 1) = n
            For j = 2 To 5
                ArrBC(n, j) = Arr(i, j - 1)
            Next
            ArrBC(n, 6) = Arr(i, k - 2)
            ArrBC(n, 7) = Arr(i, k - 1)
        End If
    End If
Next
With Sheet2
    .Range("A7").Resize(50, 7).Clear
    .Range("A7").Resize(n, 7) = ArrBC
    .Range("A7").Resize(n, 7).Borders.LineStyle = xlContinuous
    .Range("A7").Resize(n, 7).Borders(xlInsideHorizontal).Weight = xlHairline
    .Range("B6:G" & .Range("B65536").End(xlUp).Row).Sort Key1:=.Range("G6"), Order1:=xlAscending, Header:=xlYes
End With
End Sub

Maika8008 đã viết:
Lẽ ra bạn chú ý đến tác giả bài #4 có nói: Arr = Sheet1.Range("A6:R" & dc). Nếu bạn đặt như thế thì bạn sẽ đỡ đau đầu nhiều!

Tới bài #8 thì tôi đã nói nếu Arr lấy từ B thì K cũng phải match từ B, cụ thể là match("B3:BB3")
Còn vụ 2 công đoạn này ít cột hơn 2 công đoạn kia thì còn phải thêm điều kiện cho code nữa

befaint · 17/5/21

Biến n có thể có kết quả bằng 0, nên cần kiểm tra trước khi dùng Range.Resize()

ptm0412 · 18/5/21

befaint đã viết:
Biến n có thể có kết quả bằng 0, nên cần kiểm tra trước khi dùng Range.Resize()

Có câu Resume Next to đùng ở trên rồi, mặc dù bản thân mình ghét nó nhưng riêng trong code này xài được.

hml89 · 18/5/21

ptm0412 đã viết:
k tính bằng Match (3:3) ra 16, tức là 16 kể từ A = cột P
nhưng k đưa vào truy xuất Arr (i, 16) tức là 16 kể từ B, do Arr lấy dữ liệu từ B => cột Q

Code sau đây đơn giản, bỏ hết hàm format đi.

PHP:

Sub kehoachTuan() Dim Arr, ArrBC(), ToDoi As String Dim dc As Long, k As Long, n As Long, dcBC As Long, i As Long, j As Long, wn On Error Resume Next ToDoi = Sheet2.Range("C2").Value dc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row Arr = Sheet1.Range("B6:R" & dc).Value k = WorksheetFunction.Match(ToDoi, Sheet1.Range("B3:BB3"), 0) n = 0 ReDim ArrBC(1 To 50, 1 To 7) For i = 1 To UBound(Arr, 1) wn = WorksheetFunction.WeekNum(Arr(i, k - 1)) If Arr(i, k) < 1 And Arr(i, k - 1) > 1 Then If wn = Sheet2.Cells(2, "F").Value Then n = n + 1 ArrBC(n, 1) = n For j = 2 To 5 ArrBC(n, j) = Arr(i, j - 1) Next ArrBC(n, 6) = Arr(i, k - 2) ArrBC(n, 7) = Arr(i, k - 1) End If End If Next With Sheet2 .Range("A7").Resize(50, 7).Clear .Range("A7").Resize(n, 7) = ArrBC .Range("A7").Resize(n, 7).Borders.LineStyle = xlContinuous .Range("A7").Resize(n, 7).Borders(xlInsideHorizontal).Weight = xlHairline .Range("B6:G" & .Range("B65536").End(xlUp).Row).Sort Key1:=.Range("G6"), Order1:=xlAscending, Header:=xlYes End With End Sub

Tới bài #8 thì tôi đã nói nếu Arr lấy từ B thì K cũng phải match từ B, cụ thể là match("B3:BB3")
Còn vụ 2 công đoạn này ít cột hơn 2 công đoạn kia thì còn phải thêm điều kiện cho code nữa

Em cám ơn Thầy nhiều ạ, đúng là nhìn code Thầy gửi em thấy nó đơn giản và dễ hình dung. Thầy cho em hỏi chút là làm sao để biết được Match ra kết quả là 16 ạ? em chỉ đang đếm thủ công trên file data thầy ạ.

ptm0412 · 18/5/21

hml89 đã viết:
Em cám ơn Thầy nhiều ạ, đúng là nhìn code Thầy gửi em thấy nó đơn giản và dễ hình dung. Thầy cho em hỏi chút là làm sao để biết được Match ra kết quả là 16 ạ? em chỉ đang đếm thủ công trên file data thầy ạ.

Cũng đếm thủ công, hoặc gõ trực tiếp trên 1 ô nào đó. Việc đếm thủ công và viết tay ra giấy không khi nào thừa.

hml89 · 18/5/21

Maika8008 đã viết:
Thực tôi chẳng biết ý định của bạn thế nào: CẮT và ĐÓNG GÓI thì nằm ngay cột Kết thúc nhưng DŨA và BAO thì lại nằm ở cột Thực hiện? Và cũng không biết tại sao cột thực hiện lại trống rỗng dể cho bạn dùng nó làm điều kiện để lấy dữ liệu trong vòng lặp?

Nhưng dù thế nào thì bạn tham chiếu bị lệch 1 cột khiến bạn bối rối. Bạn lấy k theo hàm WorksheetFunction nên nó bảo là 16 nhưng khi xác định cột trong mảng thì nó chỉ là cột 15. Lẽ ra bạn chú ý đến tác giả bài #4 có nói: Arr = Sheet1.Range("A6:R" & dc). Nếu bạn đặt như thế thì bạn sẽ đỡ đau đầu nhiều!

Giả sử Arr = Sheet1.Range("A6:R" & dc) thì câu lệnh If Arr(i, k - 2) > 1 And Arr(i, k - 1) sẽ thành If Arr(i, k - 1) > 1 And Arr(i, k ) < 1

Tức là có 2 công đoạn đầu và cuối là chỉ có Bắt đầu và kết thúc ( 2 cột). 2 công đoạn giữa lại có Bắt đầu, kết thúc và thực hiện ( 3 cột). Điểm chung là nó đều lấy từ cột cuối của mỗi công đoạn. CŨng vì kết cấu trang tính có sẵn nên mình mới biến thiên theo.

Bài đã được tự động gộp: 18/5/21

ptm0412 đã viết:
Cũng đếm thủ công, hoặc gõ trực tiếp trên 1 ô nào đó. Việc đếm thủ công và viết tay ra giấy không khi nào thừa.

Thầy làm em nhớ lại chị Hoa mặt trời @hoamattroicoi , đi uống cafe và viêt code ra giấy...
Chúc thầy ngày mới vui vẻ ạ!

Nhờ giúp đỡ lọc kế hoạch tuần.

Thành viên tiêu biểu

File đính kèm

Bad Excel Member

Thành viên gạo cội

Bad Excel Member

Thành viên gạo cội

Thành viên tiêu biểu

Bad Excel Member

Bad Excel Member

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

Bad Excel Member

|||||||||||||

Bad Excel Member

Thành viên tiêu biểu

Bad Excel Member

Thành viên tiêu biểu