Sửa code của nút filter (1 người xem)

[minhcong.tckt]

Anh chị cho em hỏi cách sửa code của nút "filter" ở sheet "LOC" để có thể lọc cả phần ghi chú của sheet "Data" ạ

Sub CmdBtt1()    With Application        .ScreenUpdating = False        .Calculation = xlCalculationManual        .EnableEvents = False        On Error GoTo ExitSub        Dim sArray, MyArr, i As Long, j As Long        Call TestRow        sArray = Range(Sheet3.[B7], Sheet3.[I65536].End(xlUp)).Value        sArray = Filter2DArray(sArray, 7, Sheet4.ComboBox1, False)        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)        ReDim MyArr(1 To UBound(sArray), 1 To 6)        For i = 1 To UBound(sArray)            MyArr(i, 1) = i            For j = 1 To 5                MyArr(i, j + 1) = sArray(i, j)            Next        Next                    'Thu tuc kiem tra so hàng truoc khi nhap lieu:        With Sheet4            i = UBound(MyArr)            If i > 12 Then                i = i - 13                .Range("A9:G" & 9 + i).Insert 2            End If        End With        Sheet4.Range("A8").Resize(UBound(MyArr), 6).Value = MyArrExitSub:        .EnableEvents = True        .Calculation = xlCalculationAutomatic        .ScreenUpdating = True    End WithEnd Sub

 

[minhcong.tckt]

Bạn tìm đoạn sub có tên là CmdBtt1() và thay bằng đoạn sau

Sub CmdBtt1()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        On Error GoTo ExitSub
        Dim sArray, MyArr, i As Long, j As Long
        Call TestRow
        sArray = Range(Sheet3.[B7], Sheet3.[I65536].End(xlUp)).Value
        sArray = Filter2DArray(sArray, 7, Sheet4.ComboBox1, False)
        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)
        ReDim MyArr(1 To UBound(sArray), 1 To 7)
        For i = 1 To UBound(sArray)
            MyArr(i, 1) = i
            For j = 1 To 6
                MyArr(i, j + 1) = sArray(i, j)
            Next
        Next
            
        'Thu tuc kiem tra so hàng truoc khi nhap lieu:
        With Sheet4
            i = UBound(MyArr)
            If i > 12 Then
                i = i - 13
                .Range("A9:G" & 9 + i).Insert 2
            End If
        End With
        Sheet4.Range("A8").Resize(UBound(MyArr), 7).Value = MyArr
ExitSub:
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Bác có thể tô những chỗ thay thế cho em hiểu rõ được ko ạ, ghi chú thêm thì tốt quá
Nếu em muốn mở rộng DATA ra nhiều hàng nữa thì như nào ạ tầm 12 cột trước cột dk1,dk2 chẳng hạn
Bác sửa thành file mới cho em với

 

[huuthang_bd]

Bạn thay code này vào code cũ

Sub CmdBtt1()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        On Error GoTo ExitSub
        Dim sArray, MyArr, i As Long, j As Long
        Call TestRow
        sArray = Range(Sheet3.[B7], Sheet3.[I65536].End(xlUp)).Value
        sArray = Filter2DArray(sArray, 7, Sheet4.ComboBox1, False)
        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)
        ReDim MyArr(1 To UBound(sArray), 1 To 7)
        For i = 1 To UBound(sArray)
            MyArr(i, 1) = i
            For j = 1 To 6
                MyArr(i, j + 1) = sArray(i, j)
            Next
        Next
            
        'Thu tuc kiem tra so hàng truoc khi nhap lieu:
        With Sheet4
            i = UBound(MyArr)
            If i > 12 Then
                i = i - 13
                .Range("A9:G" & 9 + i).Insert 2
            End If
        End With
        Sheet4.Range("A8").Resize(UBound(MyArr), 7).Value = MyArr
ExitSub:
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

 

[minhcong.tckt]

Bạn thay code này vào code cũ

Sub CmdBtt1()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        On Error GoTo ExitSub
        Dim sArray, MyArr, i As Long, j As Long
        Call TestRow
        sArray = Range(Sheet3.[B7], Sheet3.[I65536].End(xlUp)).Value
        sArray = Filter2DArray(sArray, 7, Sheet4.ComboBox1, False)
        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)
        ReDim MyArr(1 To UBound(sArray), 1 To 7)
        For i = 1 To UBound(sArray)
            MyArr(i, 1) = i
            For j = 1 To 6
                MyArr(i, j + 1) = sArray(i, j)
            Next
        Next
            
        'Thu tuc kiem tra so hàng truoc khi nhap lieu:
        With Sheet4
            i = UBound(MyArr)
            If i > 12 Then
                i = i - 13
                .Range("A9:G" & 9 + i).Insert 2
            End If
        End With
        Sheet4.Range("A8").Resize(UBound(MyArr), 7).Value = MyArr
ExitSub:
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Muốn sheet "LOC" chỉ hiện phần nội dung, ko có hàng trống thì sửa code này như nào ạ