Cách save file excel có thời gian nhanh nhất

[batau]

Mình có viết một chương trình excel như sau. Nhưng khi giải các thuật toán ở trên mất khoảng 10 giây. Trong khi chạy lệnh save file excel lại mất đến 60 giây. Mình chạy Ontimer cập nhật theo từng phút một. Vậy có cách nào save file excel ko tốn thời gian nhất ko ? đây là code của mình. Mong mọi người giúp đỡ
'=====================================================
Application.DisplayAlerts = True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\data\data_" & l & name, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = False
Windows("online.xls").Activate
Range("A1:R120").Select
Selection.Copy
Windows("data_" & l & name).Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.DisplayAlerts = True
ActiveWorkbook.Save
Windows("data_" & l & name).Close
'=====================================================

 

[Mr Okebab]

Mình có viết một chương trình excel như sau. Nhưng khi giải các thuật toán ở trên mất khoảng 10 giây. Trong khi chạy lệnh save file excel lại mất đến 60 giây. Mình chạy Ontimer cập nhật theo từng phút một. Vậy có cách nào save file excel ko tốn thời gian nhất ko ? đây là code của mình. Mong mọi người giúp đỡ
'=====================================================
Application.DisplayAlerts = True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\data\data_" & l & name, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = False
Windows("online.xls").Activate
Range("A1:R120").Select
Selection.Copy
Windows("data_" & l & name).Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.DisplayAlerts = True
ActiveWorkbook.Save
Windows("data_" & l & name).Close
'=====================================================

Theo mặc định thì trước khi lưu excel sẽ tính toán lại toàn bộ các công thức trong file đó. Vì vậy lâu là đương nhiên.
Bạn có thể làm theo 2 cách :

1. Trước khi lưu, excel không tính toán gì cả
2. Trong File hầu như không có công thức nào cả (name, validation, condition formating cũng là công thức)

Nếu thực hiện một (hoặc cả hai) trong hai điều trên thì quá trình lưu sẽ diễn ra rất nhanh

Thân!

 

[LearnExcel]

Mình có viết một chương trình excel như sau. Nhưng khi giải các thuật toán ở trên mất khoảng 10 giây. Trong khi chạy lệnh save file excel lại mất đến 60 giây. Mình chạy Ontimer cập nhật theo từng phút một. Vậy có cách nào save file excel ko tốn thời gian nhất ko ? đây là code của mình. Mong mọi người giúp đỡ
'=====================================================
Application.DisplayAlerts = True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\data\data_" & l & name, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = False
Windows("online.xls").Activate
Range("A1:R120").Select
Selection.Copy
Windows("data_" & l & name).Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.DisplayAlerts = True
ActiveWorkbook.Save
Windows("data_" & l & name).Close
'=====================================================

Bạn có thể sửa lại phần code phần copy và paste một chút được chứ, hy vọng cũng góp phần nhanh hơn đó

7/ Tránh sử dụng Copy và Paste bất cứ khi nào có thể:

Sub NoCopyAndPaste()

'Thay vi:
Sheet1.Range("A1:A200").Copy Destination:=Sheet2.Range("B1")
'Thi su dung:

Sheet2.Range("B1:B200").Value= Sheet1.Range("A1:A200").Value

'Hay:
Sheet2.Range("B1:B200").Formula = Sheet1.Range("A1:A200").Formula

'Thay vi:
Sheet1.Range("A1:A200").Copy
Sheet1.Range("A1:A200").PasteSpecial xlPasteValues

'Thi su dung:
Sheet1.Range("A1:A200") = Sheet1.Range("A1:A200").Value
End Sub

Theo bài này nhé http://www.giaiphapexcel.com/forum/showthread.php?t=37

 

[batau]

Mình thực sự cảm ơn Mr Okebab và LearnExcel. Phần code của mình trên có sử dụng lệnh copy paste nhiều. Mà copy và paste thì sẽ lưu vào clipboard. Điều này làm cho dung lượng của của clipboard cứ thể tăng dần dần lên. Và chiếm bộ nhớ ảo -> cũng dẫn tới việc làm tốc độ chương trình bị chậm đi. Cách này mình sẽ thử theo LearnExcel để tránh việc lưu vào clipboard. Nhưng khi copy và paste sang 2 workbook khác nhau thi ko làm đc như LearnExcel . Vậy có cách nào để clear bộ nhớ trong clipboard đươc đi ko nhỉ?
@ Mr Okebab : Trong file Excel của mình toàn chữ và số ko có một công thức nào cả nhưng ko biết có phải do mình chạy lệnh ontimer theo 1 phút một. Mình giả sử khi chương trình chưa chạy xong nhưng Ontimer bắt chạy lại từ đầu -> dẫn tới râu ông nọ cắm cằm bà kia ko nhỉ. Làm đã chậm rồi lại càng chậm hơn. Khi save as file excel có định dạng nào giảm thiểu thời gian đi ko nhỉ như dạng text hay Unicode.
Mong mọi người giúp đỡ mình.

 

[batau]

Hàm time của mình có gọi theo cách sau
Public dTime As Date
sub data()

dTime = Now + TimeValue("00:01:00")

Application.OnTime dTime, "data"
end sub

 

[LearnExcel]

Nhưng khi copy và paste sang 2 workbook khác nhau thi ko làm đc như LearnExcel . Vậy có cách nào để clear bộ nhớ trong clipboard đươc đi ko nhỉ?

Trước đây tôi cũng nghĩ như bạn nhưng đọan code như sau làm việc rất tốt

Sub better()

Dim myWks As Worksheet
Set myWks = ThisWorkbook.Sheets(x)

Dim UrWks As Worksheet
Set UrWks = Workbooks(UrWksName).Sheets(y)

myWks.Range("A1:A10").Value = UrWks.Range("B1:B10").Value

Set myWks = Nothing
Set UrWks = Nothing

End Sub

Nhớ khai báo chính xác x, y, UrWksName nhé! kích thước của 2 range cũng phải giống nhau. Có thể gán value hay formula,...

Một phút là quá thừa cho khỏang vài nghìn cells!

Mình thực sự cảm ơn Mr Okebab và LearnExcel.

Chỉ việc nhấn nút Thank là được rồi mà!

 

[batau]

Trong cái excel của mình còn có một cell mình muốn lấy thời gian hiện tại trên may tinh. Vị dụ vào lúc mình save là lúc taskbar là 10:30 thì một cell cua mình cũng hiện là 10:30. Ban có biết code này lấy thời gian trên máy tinh ko? gửi cho mình với. Thank rất nhiều

 

[TranThanhPhong]

Trong cái excel của mình còn có một cell mình muốn lấy thời gian hiện tại trên may tinh. Vị dụ vào lúc mình save là lúc taskbar là 10:30 thì một cell cua mình cũng hiện là 10:30. Ban có biết code này lấy thời gian trên máy tinh ko? gửi cho mình với. Thank rất nhiều

Bạn nhấn Alt+F11 trên file muốn chèn code, nhấp chuột 2 lần lên ThisWorkbook và dán đoạn code sau vào:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Sheet1").Range("A1").Value = Now()
End Sub

Hy vọng đúng ý bạn
TP.

 

[batau]

Theo hướng dẫn của mọi người mình đã làm xong. Mình đang muốn tối ưu kết quả chạy của mình. Mình import từng trang web nhưng để import mình luôn phải active một workbook và sheet. Như vậy rất bất tiện cho mình, khi đang mở một trang excel thì khi cập nhập dữ liệu, nó lại bắt mở một trang cập nhật , vạy có cách nào import mà ko cần active workbook ko ? đây là đoạn code của mình. Mình làm nhờ recoder macro
-------------------------------------------------
Windows("online.xls").Activate
Sheets("Sheet1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.bsc.com.vn/OP/requester.htm",Destination:=Range("A1"))
.name = "requester"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

 

[LearnExcel]

bận nên nêu rõ yêu cầu bài toán của bạn từ ý tưởng ban đầu thì mọi người dễ hiểu hơn là giúp từng đoạn một như thế này

 

[LearnExcel]

Bạn có thể tham khảo đoạn code sau và sửa lại cho phù hợp với yêu cầu

'Retrieve USD exchange rates using a Web Query
Sub GetRatesWithWebQuery()
    Dim oBk As Workbook
    Dim oQT As QueryTable
    'Store the current settings of Excel's number formatting
    Dim sDecimal As String
    Dim sThousand As String
    Dim bUseSystem As Boolean
    'Create a new workbook
    Set oBk = Workbooks.Add
    'Create a query table to download USD rates
    With oBk.Worksheets(1)
        Set oQT = .QueryTables.Add( _
                  Connection:="URL; http://www.x-rates.com/d/USD/table.html", _
                  Destination:=.Range("A1"))
    End With
    'Set the QueryTable's properties
    With oQT
        .Name = "USD"
        'State that we're selecting a specific table
        .WebSelectionType = xlSpecifiedTables
        'Import the 5th table on the page
        .WebTables = "5"
        'Ignore the web page's formatting
        .WebFormatting = xlWebFormattingNone
        'Do not try to recognise dates
        .WebDisableDateRecognition = True
        'Don't automatically refresh the query each time the file is opened
        .RefreshOnFileOpen = False
        'Waiting for the query to complete before continuing
        .BackgroundQuery = True
        'Save the query data with the workbook
        .SaveData = True
        'Adjust column widths to autofit new data
        .AdjustColumnWidth = True
    End With
    With Application
        'Remember Excel's current number format settings
        sDecimal = .DecimalSeparator
        sThousand = .ThousandsSeparator
        bUseSystem = .UseSystemSeparators
        'Set Excel's separators to match those of the web site
        .DecimalSeparator = "."
        .ThousandsSeparator = ","
        .UseSystemSeparators = True
        'Ignore any errors raised by the query failing
        On Error Resume Next
        'Perform the query, waiting for it to complete
        oQT.Refresh BackgroundQuery:=False
        'Reset Excel's number format settings
        .DecimalSeparator = sDecimal
        .ThousandsSeparator = sThousand
        .UseSystemSeparators = bUseSystem
    End With
End Sub

 

[batau]

Đoạn code trên, mình lấy từ việc recoder marco. Ý tưởng của mình là sẽ ghi kết quả của trang web liên tục sau 2 phút một va mình cho chạy tại nhà. Khi trang web hay mạng có một lỗi bất kỳ ko load đc trang web về thì ngay lập tức excel báo lỗi ở ( .Refresh BackgroundQuery:=False ) và kết quả sẽ dừng lại ngay lập tức, và ko cho chạy nữa. Trường hợp bị lỗi mạng này thường chỉ xuất hiện 1 đến 2 lần, nếu mình có ở đấy có thẻ cho chạy lại nhưng mình ko ở đấy dẫn tới về đến nhà gần như chi 1 cái lỗi mạng ban đầu là ko làm đc gì nữa. Bạn có cách nào giúp mình đc ko ?
Chân thành cảm ơn

Lúc đấy có báo lỗi là
Run-time error '1004'
Unable to open ' http://www. .com cannot download the information you request

 

[LearnExcel]

Bẫy lỗi bằng cách chèn thêm

On Error Resume trước đoạn code bị lỗi xem có được không!