Như tiêu đề ạ.. tình hình là e lập dự toán bằng excel.. và cơ sở dữ liệu của nó rất nặng ( gồm 8000 định mức và các giá trị phân tích giá).. nên e đã làm 1 hàm để giá trị nào e cần lấy thì sẽ có giá trị.. còn giá trị nào e k lấy nó sẽ trả về N/A để ẩn đi dòng N/A và in ấn.. nhưng khi gửi cho người ta xem thì file quá nặng.. nên e xin nhờ các bác giúp e lệnh để tự động lưu file sang file mới và xóa tất cả các dòng có giá trị N/A ạ.. e chân thành cảm ơn các bác nhiều ạ.. Vì file quá nặng nên ai giúp e e gửi file qua nhờ các bác xem hộ chứ e k up lên được ạ
Như tiêu đề ạ.. tình hình là e lập dự toán bằng excel.. và cơ sở dữ liệu của nó rất nặng ( gồm 8000 định mức và các giá trị phân tích giá).. nên e đã làm 1 hàm để giá trị nào e cần lấy thì sẽ có giá trị.. còn giá trị nào e k lấy nó sẽ trả về N/A để ẩn đi dòng N/A và in ấn.. nhưng khi gửi cho người ta xem thì file quá nặng.. nên e xin nhờ các bác giúp e lệnh để tự động lưu file sang file mới và xóa tất cả các dòng có giá trị N/A ạ.. e chân thành cảm ơn các bác nhiều ạ.. Vì file quá nặng nên ai giúp e e gửi file qua nhờ các bác xem hộ chứ e k up lên được ạ
Sub Test()
Dim rws As Long
With Sheets("ptgia")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Call SaveAs_
End Sub
Sub SaveAs_()
Dim strP As String
Dim newName
Dim rws As Long
strP = ActiveWorkbook.Path
newName = ActiveWorkbook.Name
i = InStrRev(newName, ".")
newName = Left(newName, i - 1) & "_" & "New" & ".xlsb"
ChDir strP
ActiveWorkbook.SaveAs Filename:=strP & "\" & newName, FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Sub Test()
Dim rws As Long
With Sheets("ptgia")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Call SaveAs_
End Sub
Sub SaveAs_()
Dim strP As String
Dim newName
Dim rws As Long
strP = ActiveWorkbook.Path
newName = ActiveWorkbook.Name
i = InStrRev(newName, ".")
newName = Left(newName, i - 1) & "_" & "New" & ".xlsb"
ChDir strP
ActiveWorkbook.SaveAs Filename:=strP & "\" & newName, FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Sub Test()
Dim rws As Long
With Sheets("ptgia")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Call SaveAs_
End Sub
Sub SaveAs_()
Dim strP As String
Dim newName
Dim rws As Long
strP = ActiveWorkbook.Path
newName = ActiveWorkbook.Name
i = InStrRev(newName, ".")
newName = Left(newName, i - 1) & "_" & "New" & ".xlsb"
ChDir strP
ActiveWorkbook.SaveAs Filename:=strP & "\" & newName, FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Sub Test()
Dim rws As Long
With Sheets("ptgia")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Call SaveAs_
End Sub
Sub SaveAs_()
Dim strP As String
Dim newName
Dim rws As Long
strP = ActiveWorkbook.Path
newName = ActiveWorkbook.Name
i = InStrRev(newName, ".")
newName = Left(newName, i - 1) & "_" & "New" & ".xlsb"
ChDir strP
ActiveWorkbook.SaveAs Filename:=strP & "\" & newName, FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Chào a.. e đã thử chạy code này nhưng nó lưu ra 1 file mới nhẹ hơn file cũ và e kiểm tra thì thấy những dòng N/A vẫn chưa bị xóa ạ.. e có thể khắc phục ntn ạ
code bài trên là chỉ xóa cho sheet "ptgia". Còn Sheet "Gia VL" thì chưa.
Trong sheet "ptgia", cột V, lỗi N/A là đã xóa hết, các cột khác không xét. Bạn kiểm tra lỗi còn N/A có lẽ là tại sheet "Gia VL"
Thông báo lỗi khi chạy code là do khai báo thiếu biến "i" trong sub SaveAs_, thêm khai báo i là được.
Đoạn code dưới đây thêm khai báo biến i trong sub saveas_ & thêm đoạn xóa sheet "Gia VL"
---
Giờ bạn làm thế này:
Vào các sheet :"ptgia", "Gia VL" tháo bỏ hết autofilter. Dán đoạn code dưới đây vào module. Lưu file dưới dạng .xlsb hoặc .xlsm.
Làm các bước trên rồi chạy macro test
Mã:
Option Explicit
Sub Test()
Dim rws As Long
Sheets("ptgia").Activate
With Sheets("ptgia")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Sheets("Gia VL").Activate
With Sheets("Gia VL")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Call SaveAs_
End Sub
Private Sub SaveAs_()
Dim strP As String
Dim newName
Dim rws As Long, i
strP = ActiveWorkbook.Path
newName = ActiveWorkbook.Name
i = InStrRev(newName, ".")
newName = Left(newName, i - 1) & "_" & "New" & ".xlsb"
ChDir strP
ActiveWorkbook.SaveAs Filename:=strP & "\" & newName, FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Hiện tại File này nếu máy yếu thì không thể mở lên được.
Vì vậy, tôi khuyên bạn bỏ ngay cái File này và nên làm lại cái File mới, nếu không thì có ngày máy bạn cũng sẽ không thể mở được File này, vì những lý do sau:
1/ Có vài chục cái Link đến File khác.
2/ Có vài ngàn Style rác, Name rác và Name ma.
3/ Không nên tô màu trắng cả sheet như sheet: TH, THCPTB, ptgia (đây cũng là nguyên nhân tăng dung lượng File).
code bài trên là chỉ xóa cho sheet "ptgia". Còn Sheet "Gia VL" thì chưa.
Trong sheet "ptgia", cột V, lỗi N/A là đã xóa hết, các cột khác không xét. Bạn kiểm tra lỗi còn N/A có lẽ là tại sheet "Gia VL"
Thông báo lỗi khi chạy code là do khai báo thiếu biến "i" trong sub SaveAs_, thêm khai báo i là được.
Đoạn code dưới đây thêm khai báo biến i trong sub saveas_ & thêm đoạn xóa sheet "Gia VL"
---
Giờ bạn làm thế này:
Vào các sheet :"ptgia", "Gia VL" tháo bỏ hết autofilter. Dán đoạn code dưới đây vào module. Lưu file dưới dạng .xlsb hoặc .xlsm.
Làm các bước trên rồi chạy macro test
Mã:
Option Explicit
Sub Test()
Dim rws As Long
Sheets("ptgia").Activate
With Sheets("ptgia")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Sheets("Gia VL").Activate
With Sheets("Gia VL")
rws = .Range("V1000000").End(xlUp).Row
.Range("A2", "V" & rws).Select
Selection.AutoFilter
Range("V2").Select
ActiveSheet.Range("$A$2:$IP$24229").AutoFilter Field:=22, Criteria1:= _
"=#N/A", Operator:=xlAnd
Range("V5").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
End With
Call SaveAs_
End Sub
Private Sub SaveAs_()
Dim strP As String
Dim newName
Dim rws As Long, i
strP = ActiveWorkbook.Path
newName = ActiveWorkbook.Name
i = InStrRev(newName, ".")
newName = Left(newName, i - 1) & "_" & "New" & ".xlsb"
ChDir strP
ActiveWorkbook.SaveAs Filename:=strP & "\" & newName, FileFormat:=xlExcel12, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Hiện tại File này nếu máy yếu thì không thể mở lên được.
Vì vậy, tôi khuyên bạn bỏ nay cái File này và nên làm lại cái File mới, nếu không thì có ngày máy bạn cũng sẽ không thể mở được File này, vì những lý do sau:
1/ Có vài chục cái Link đến File khác.
2/ Có vài ngàn Style rác, Name rác và Name ma.
3/ Không nên tô màu trắng cả sheet như: TH, THCPTB, ptgia (đây cũng là nguyên nhân tăng dung lượng File).