Nhờ các anh chị giúp mình viết lệnh VBA xóa công thức trong excel. (1 người xem)

[TayMonKhanh]

Kính gửi các bạn

Mình có một số file tính, do đối tác yêu cầu bắt buộc gửi file tính cho họ, nhưng mình chỉ muốn gửi cho họ phần kết quả tính toán (phần để in ra ngoài) nằm trên sheet đầu tiên. Còn các sheet phía sau thì chỉ là các bảng số liệu phục vụ tính toán thì mình muốn chỉ giữ lại các ô có giá trị số học để nó cung cấp về sheet trình bày, còn lại thì xóa đi những thứ không cần thiết, như:

+ Các dòng chữ viết có trong bảng tính.
+ Các dòng comment chú thích.
+ Các đối tượng Form.
+ Các ô chứa công thức thì copy nó và dán lại dạng values.
+ Quét hết các format hiện có của các ô về 1 format mặc định, Ví dụ: font chữ là Times New Roman, chiều cao chữ =10.v.v.

Mình viết các dòng lệnh như trên để phục vụ nó (Button: “Xóa thông tin” nằm ở đầu sheet “Tables”). Tuy nhiên do mình không có kiến thức về VBA nên đoạn lệnh chạy quá chậm, khi gặp các sheet có kích thước lớn thì thời gian xóa lên đến mười mấy phút.

Nhờ các anh chị góp ý để mình viết lại đoạn code cho ngắn và chạy nhanh hơn.

Xin cám ơn rất nhiều!

 

[dovanhoc84]

Mình viết các dòng lệnh như trên để phục vụ nó (Button: “Xóa thông tin” nằm ở đầu sheet “Tables”). Tuy nhiên do mình không có kiến thức về VBA nên đoạn lệnh chạy quá chậm, khi gặp các sheet có kích thước lớn thì thời gian xóa lên đến mười mấy phút.

Nhờ các anh chị góp ý để mình viết lại đoạn code cho ngắn và chạy nhanh hơn.

Xin cám ơn rất nhiều!

Lỗi chạy chậm k phải do macro của bạn, mà đa phần là do các sub khác chạy nên mất thời gian thôi.
cụ thể nếu bạn vào xem trong workbook sẽ thấy một loạt các sub khởi chạy khi sheet thay đổi, do vậy khi macro của bạn chạy 1 lệnh là nó lại gọi sub đó ra kiểm tra.
Vậy nên bạn thử copy sang 1 workbook khác chạy sub bạn chạy xem, chắc k đến lỗi mất nhiều tgian vậy.

Ngoài ra còn do cái cách clear format của bạn cũng có vấn đề vậy nên cái macro được record cũng thành dài dòng phức tạp thôi.

 

[TayMonKhanh]

Cảm ơn dovanhoc84 đã góp ý!
Như vậy là đoạn macro này có thể chấp nhận được rồi phải không bạn? Mình cứ e ngại vấn đề chậm này là do đoạn code (chủ yếu là copy từ chức năng ghi tự động) vụng về, mình phải dò tìm từng ô để lọc và xóa, rất là nông dân... nên mình muốn hỏi thăm để hoàn thiện nó hơn.
Cảm ơn bạn nhiều

 

[giaiphap]

Cảm ơn dovanhoc84 đã góp ý!
Như vậy là đoạn macro này có thể chấp nhận được rồi phải không bạn? Mình cứ e ngại vấn đề chậm này là do đoạn code (chủ yếu là copy từ chức năng ghi tự động) vụng về, mình phải dò tìm từng ô để lọc và xóa, rất là nông dân... nên mình muốn hỏi thăm để hoàn thiện nó hơn.
Cảm ơn bạn nhiều

Code của bạn viết vậy chậm là đúng rồi, bạn mô tả lại cụ thể và chi tiết hơn mục đích của bạn là gì mình sửa lại code cho.

 

[TayMonKhanh]

Cảm ơn bạn giaiphap

File tính của mình có nhiều sheet. Trong đó Sheet1 là sheet trình bày phần thuyết minh để in ra kẹp vào hồ sơ thiết kế. Các sheet còn lại là các mô đun tính phụ trợ, phục vụ giải những bài toán con, cuối cùng là dẫn link số liệu từ các sheet phụ trợ về sheet 1 để trình bày và in ấn. Đương nhiên trên các sheet phụ trợ có đầy đủ các thông tin như:

+ Các dòng text mình chú giải trong bảng tính.
+ Các dòng comment chú thích cho các ô.
+ Các đối tượng Form.
+ Các công thức tính.

Mình làm tư vấn nên có rất nhiều file tính toán. Chủ đầu tư yêu cầu mình nộp file tính cho họ, nhưng mình tiếc vì mình tốn rất nhiều công phu để lập ra, trong khi họ chỉ cần có tí quyền là thu thập được file tính của mình rồi phát tán cho các đơn vị tư vấn khác. Nên mình muốn tạo 1 macro, để khi Chủ đầu tư yêu cầu gửi file tính thì mình dùng macro đó dến các sheet phụ trợ thực hiện các công việc sau:

+ Xóa hết các dòng text, các dòng comment, các đối tượng Form.v.v. chú giải trong sheet phụ trợ.
+ Các ô chứa số liệu thì giữ nguyên, các ô chứa công thức tính thì copy nó và dán lại dạng values.
+ Định dạng lại toàn bộ sheet theo mặc định (không có tô màu, kẻ bảng).

Rất mong bạn giúp đỡ, hy vọng được giúp lại bạn trong một công việc khác, hoặc mình gửi chi phí cafe cảm ơn bạn đã tốn thời gian và tâm trí để viết code cho mình! Trân trọng và cảm ơn bạn rất nhiều!

 

[giaiphap]

Cảm ơn bạn giaiphap

File tính của mình có nhiều sheet. Trong đó Sheet1 là sheet trình bày phần thuyết minh để in ra kẹp vào hồ sơ thiết kế. Các sheet còn lại là các mô đun tính phụ trợ, phục vụ giải những bài toán con, cuối cùng là dẫn link số liệu từ các sheet phụ trợ về sheet 1 để trình bày và in ấn. Đương nhiên trên các sheet phụ trợ có đầy đủ các thông tin như:

+ Các dòng text mình chú giải trong bảng tính.
+ Các dòng comment chú thích cho các ô.
+ Các đối tượng Form.
+ Các công thức tính.

Mình làm tư vấn nên có rất nhiều file tính toán. Chủ đầu tư yêu cầu mình nộp file tính cho họ, nhưng mình tiếc vì mình tốn rất nhiều công phu để lập ra, trong khi họ chỉ cần có tí quyền là thu thập được file tính của mình rồi phát tán cho các đơn vị tư vấn khác. Nên mình muốn tạo 1 macro, để khi Chủ đầu tư yêu cầu gửi file tính thì mình dùng macro đó dến các sheet phụ trợ thực hiện các công việc sau:

+ Xóa hết các dòng text, các dòng comment, các đối tượng Form.v.v. chú giải trong sheet phụ trợ.
+ Các ô chứa số liệu thì giữ nguyên, các ô chứa công thức tính thì copy nó và dán lại dạng values.
+ Định dạng lại toàn bộ sheet theo mặc định (không có tô màu, kẻ bảng).

Rất mong bạn giúp đỡ, hy vọng được giúp lại bạn trong một công việc khác, hoặc mình gửi chi phí cafe cảm ơn bạn đã tốn thời gian và tâm trí để viết code cho mình! Trân trọng và cảm ơn bạn rất nhiều!

Sheet phụ trợ là sheet nào vậy bạn?

 

[TayMonKhanh]

Sheet phụ trợ là sheet nào vậy bạn?

Trong file đính kèm bên trên thì Sheet Calculation là sheet trình bày để in, còn các sheet còn lại là phụ trợ hết. Tuy nhiên, công ty tư vấn mà, nên có nhiều file tính lắm chứ không chỉ file này, và tên sheet phụ trợ trong mỗi file tính đều là khác nhau. Do đó, nếu được thì bạn giúp cho mình đoạn code, sau này khi muốn xóa sheet nào thì mình bật sheet đó lên dán code vào chạy là thuận tiện nhất! Cảm ơn.

 

[giaiphap]

Trong file đính kèm bên trên thì Sheet Calculation là sheet trình bày để in, còn các sheet còn lại là phụ trợ hết. Tuy nhiên, công ty tư vấn mà, nên có nhiều file tính lắm chứ không chỉ file này, và tên sheet phụ trợ trong mỗi file tính đều là khác nhau. Do đó, nếu được thì bạn giúp cho mình đoạn code, sau này khi muốn xóa sheet nào thì mình bật sheet đó lên dán code vào chạy là thuận tiện nhất! Cảm ơn.

Trong file của bạn quá nhiều name rác và lỗi, bạn hãy xóa tất cả những name không dùng tới và gửi lại cái file đó lên đây mình viết code giúp cho. Khi xóa những cái yêu cầu của bạn rồi gửi file tất cả các sheet hay chỉ có sheet đang chọn? có cần tách sheet đó ra file khác hay không?...
Nhìn code trong file của bạn nên đoán đại thôi, hy vọng đúng ý bạn. bạn thay đoạn code trong module1 của bạn như sau:

Sub Button387_Click()
On Error Resume Next
bienmin_i@ = Range("A1").Value
bienmax_i@ = Range("A2").Value

bienmin_j@ = Range("A3").Value
bienmax_j@ = Range("A4").Value
'Tat tinh toan
Options_Event False
'-------------------------------------------
  'Dinh dang lai o va xoa tat ca cac ghi chu
  Dim Rng As Range, sCell As Range, cCell As Range
    Set Rng = Range(Cells(bienmin_i@, bienmin_j@), Cells(bienmax_i@, bienmax_j@))
    ActiveSheet.UsedRange.ClearComments
    With Rng
        .ClearFormats
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    Application.CutCopyMode = False
'-------------------------------------------------
'Xoa tat ca cac o chua text
For Each cCell In Rng
    If Not IsNumeric(cCell) Then
        If sCell Is Nothing Then
            Set sCell = cCell
        Else
            Set sCell = Union(sCell, cCell)
        End If
    End If
Next cCell
'-------------------------------------------------
'Xoa tat ca bang dieu khien
'ActiveSheet.DrawingObjects.Select
'Selection.Delete
'-------------------------------------------------
If Not sCell Is Nothing Then sCell.ClearContents
'Mo lai tinh toan
Options_Event True
MsgBox "Da thuc hien xong"
End Sub

Public Sub Options_Event(kt As Boolean)
Application.ScreenUpdating = kt
Application.EnableEvents = kt
Application.DisplayAlerts = kt
If Not kt Then Application.Calculation = xlCalculationManual Else Application.Calculation = xlCalculationAutomatic
End Sub

 

[TayMonKhanh]

Trong file của bạn quá nhiều name rác và lỗi, bạn hãy xóa tất cả những name không dùng tới và gửi lại cái file đó lên đây mình viết code giúp cho. Khi xóa những cái yêu cầu của bạn rồi gửi file tất cả các sheet hay chỉ có sheet đang chọn? có cần tách sheet đó ra file khác hay không?...
Nhìn code trong file của bạn nên đoán đại thôi, hy vọng đúng ý bạn. bạn thay đoạn code trong module1 của bạn như sau:

Sub Button387_Click()
On Error Resume Next
bienmin_i@ = Range("A1").Value
bienmax_i@ = Range("A2").Value

bienmin_j@ = Range("A3").Value
bienmax_j@ = Range("A4").Value
'Tat tinh toan
Options_Event False
'-------------------------------------------
  'Dinh dang lai o va xoa tat ca cac ghi chu
  Dim Rng As Range, sCell As Range, cCell As Range
    Set Rng = Range(Cells(bienmin_i@, bienmin_j@), Cells(bienmax_i@, bienmax_j@))
    ActiveSheet.UsedRange.ClearComments
    With Rng
        .ClearFormats
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    Application.CutCopyMode = False
'-------------------------------------------------
'Xoa tat ca cac o chua text
For Each cCell In Rng
    If Not IsNumeric(cCell) Then
        If sCell Is Nothing Then
            Set sCell = cCell
        Else
            Set sCell = Union(sCell, cCell)
        End If
    End If
Next cCell
'-------------------------------------------------
'Xoa tat ca bang dieu khien
'ActiveSheet.DrawingObjects.Select
'Selection.Delete
'-------------------------------------------------
If Not sCell Is Nothing Then sCell.ClearContents
'Mo lai tinh toan
Options_Event True
MsgBox "Da thuc hien xong"
End Sub

Public Sub Options_Event(kt As Boolean)
Application.ScreenUpdating = kt
Application.EnableEvents = kt
Application.DisplayAlerts = kt
If Not kt Then Application.Calculation = xlCalculationManual Else Application.Calculation = xlCalculationAutomatic
End Sub

Cảm ơn bạn giaiphap! Mình đã nhận được code do bạn sửa lại. Không cần làm phiền bạn viết code mới giúp mình gì nữa đâu. Chỉ cần dùng đoạn code bạn sửa lại ở bên trên là đủ đáp ứng nhu cầu hiện tại của mình rồi. Bạn lợi hại thật, nó nhanh hơn đoạn code cũ rất nhiều lần. Mình lớn tuổi rồi > 40t, mình ở Tp. HCM, làm bên xây dựng. VBA thì mình lem nhem do mình chỉ tự mò mẫm và cũng không có nhiều thời gian để mò mẫm, còn những vấn đề khác thì mình khá ổn. Hy vọng có thể giúp lại bạn một vấn đề gì đó, hoặc mời bạn ly cafe để cảm ơn!
Cảm ơn bạn!