Xử lý giúp code autohide nhanh hơn và tự thêm dòng có điều kiện

[tienphat85]

Mình nhờ các bạn giúp!

Mình có 3 sheet (Tổng, tm, bn)
Mình nhập số liệu bên Tong, 2 sheet còn lại tự động cập nhật số liệu.
Khi in báo cáo thì chọn 1 trong 2 sheet tm & bn. Điều vướng mắc:
1. Khi chọn sheet thì autohide nó chạy chậm, mất khoảng 1p để chạy xong (dữ liệu ít), nếu dữ liệu nhiều hơn thì như rùa. Nhờ các bạn cải thiện giúp code đã có trong sheet.
2. Khi nhập bảng Tong đến ô cuối cùng còn 1 ô trống thì tự chèn dòng và kiểm tra 2 sheet còn lại thiếu dòng (nếu bên Tong nhiều dòng hơn dữ liệu 1500 dòng _ cập nhật dữ liệu 2 sheet còn lại) (bên 1 trong 2 sheet tm & bn hơn 700 dòng) thì tự chèn và copy công thức luôn.

Xin cảm ơn!

Link file: (giới hạn còn 0.5m mà file 1,1m nên ko up đc)
http://www.mediafire.com/download/nbaas7gnzad3bqa/ban+hang.xls

 

[quanluu]

Mình nhờ các bạn giúp!

Mình có 3 sheet (Tổng, tm, bn)
Mình nhập số liệu bên Tong, 2 sheet còn lại tự động cập nhật số liệu.
Khi in báo cáo thì chọn 1 trong 2 sheet tm & bn. Điều vướng mắc:
1. Khi chọn sheet thì autohide nó chạy chậm, mất khoảng 1p để chạy xong (dữ liệu ít), nếu dữ liệu nhiều hơn thì như rùa. Nhờ các bạn cải thiện giúp code đã có trong sheet.
2. Khi nhập bảng Tong đến ô cuối cùng còn 1 ô trống thì tự chèn dòng và kiểm tra 2 sheet còn lại thiếu dòng (nếu bên Tong nhiều dòng hơn dữ liệu 1500 dòng _ cập nhật dữ liệu 2 sheet còn lại) (bên 1 trong 2 sheet tm & bn hơn 700 dòng) thì tự chèn và copy công thức luôn.

Xin cảm ơn!

Link file: (giới hạn còn 0.5m mà file 1,1m nên ko up đc)
http://www.mediafire.com/download/nbaas7gnzad3bqa/ban+hang.xls

ý 1

Private Sub Worksheet_Activate()
    ActiveSheet.Range("$A$4:$I$700").AutoFilter Field:=4, Criteria1:="<>"
End Sub

ý 2 thì không hiểu lắm. Theo mình, đã dùng code và dữ liệu nhiều thì dùng code hết đi, công thức làm gì cho mệt

 

[tienphat85]

ý 1

Private Sub Worksheet_Activate()
    ActiveSheet.Range("$A$4:$I$700").AutoFilter Field:=4, Criteria1:="<>"
End Sub

ý 2 thì không hiểu lắm. Theo mình, đã dùng code và dữ liệu nhiều thì dùng code hết đi, công thức làm gì cho mệt

Ý 2: Tự động thêm dòng của 2 sheet tm & bn nếu dữ liệu bên Tong đưa qua vượt quá 700 dòng (730 dòng hay 740 dòng chẳng hạn)

 

[giaiphap]

Ý 2: Tự động thêm dòng của 2 sheet tm & bn nếu dữ liệu bên Tong đưa qua vượt quá 700 dòng (730 dòng hay 740 dòng chẳng hạn)

Bạn thử code này cho sheet TM thử xem.

Private Sub Worksheet_Activate()
Dim dong As Long, k As Long
Application.ScreenUpdating = False
k = Application.WorksheetFunction.CountIf(Sheet1.Range("F5:F65000"), "TM")
dong = Range("A65000").End(xlUp).Row
If dong - 3 >= 6 Then Rows("6:" & (dong - 3)).Delete Shift:=xlUp
Rows("6:" & (k + 4)).Insert Shift:=xlDown
Range("A5:I5").AutoFill Destination:=Range("A5:I" & (k + 5))
Application.ScreenUpdating = True
End Sub

 

[quanluu]

Ý 2: Tự động thêm dòng của 2 sheet tm & bn nếu dữ liệu bên Tong đưa qua vượt quá 700 dòng (730 dòng hay 740 dòng chẳng hạn)

theo mình không nên dùng công thức
Dùng sub này và trong sự kiện active của từng sheet thì call và truyền tham số.

Sub run(ht As String)
Dim i, k, lr As Integer, arr
Application.ScreenUpdating = False
With Sheets("Tong")
    lr = .Range("B10000").End(3).Row
    ReDim arr(1 To lr, 1 To 8)
    For i = 5 To lr
        If .Cells(i, 6) = ht Then
            k = k + 1
            arr(k, 1) = k
            arr(k, 2) = .Cells(i, 2)
            arr(k, 3) = .Cells(i, 3)
            arr(k, 4) = .Cells(i, 4)
            arr(k, 5) = .Cells(i, 5)
            arr(k, 6) = .Cells(i, 7)
            arr(k, 7) = .Cells(i, 8)
            arr(k, 8) = .Cells(i, 9)
        End If
    Next
End With
 
ActiveSheet.Range("A5").Resize(k + 1, 8) = arr
lr = ActiveSheet.Range("B10000").End(3).Row + 1
ActiveSheet.Cells(lr, 4) = "Tong"
ActiveSheet.Cells(lr, 8).Formula = "=Sum(H5:H" & lr - 1 & ")"
Range("A5:H" & lr).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

 

[tienphat85]

Bạn thử code này cho sheet TM thử xem.

Private Sub Worksheet_Activate()
Dim dong As Long, k As Long
Application.ScreenUpdating = False
k = Application.WorksheetFunction.CountIf(Sheet1.Range("F5:F65000"), "TM")
dong = Range("A65000").End(xlUp).Row
If dong - 3 >= 6 Then Rows("6:" & (dong - 3)).Delete Shift:=xlUp
Rows("6:" & (k + 4)).Insert Shift:=xlDown
Range("A5:I5").AutoFill Destination:=Range("A5:I" & (k + 5))
Application.ScreenUpdating = True
End Sub

Code chạy được nhưng có khuyết điểm là có 3 dữ liệu cuối cùng trùng nhau