我正在決議一個作業表中的資料并在另一個作業表中創建兩列,然后將該新作業表保存到一個制表符描述的檔案中。它會在幾秒鐘內完成約 30-35 次,然后立即減慢至每分鐘約 1 次。關于它為什么變慢或如何診斷問題的任何想法?
Sub DataMove()
Dim wksName As String
Dim FolderPath As String
Dim OrgWks As String
Dim wkbName As String
Dim wb As Workbook
Dim RowNum As Long
Dim ColNum As Long
Dim NameRow As Long
Dim DestRow As Long
Dim NumRows As Long
Dim NumRows2 As Long
Dim NumCols As Long
DestRow = 1
ColNum = 8
RowNum = 4
wkbName = Application.ActiveWorkbook.Name
FolderPath = Application.ActiveWorkbook.Path
OrgWks = ActiveSheet.Name
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
NumCols = Range("G4", Range("G4").End(xlToRight)).Columns.Count
NumCols = NumCols 6
While RowNum <= NumRows
Workbooks(wkbName).Activate
NameRow = RowNum - 2
wksName = Worksheets(OrgWks).Cells(NameRow, 29).Value
Sheets.Add Type:=xlWorksheet
ActiveSheet.Name = wksName
While ColNum < NumCols
With Worksheets(wksName)
.Cells(DestRow, 1).Value = Worksheets(OrgWks).Cells(RowNum, ColNum)
.Cells(DestRow, 2).Value = Worksheets(OrgWks).Cells(RowNum, ColNum - 1)
ColNum = ColNum 3
DestRow = DestRow 1
End With
Wend
RowNum = RowNum 3
ColNum = 8
DestRow = 1
NumRows2 = Range("A1", Range("A1").End(xlDown)).Rows.Count
Cells(1, 1).Select
Selection.Resize(NumRows2, 2).Copy
Set wb = Workbooks.Add
Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wb.SaveAs Filename:=FolderPath & "\" & wksName, FileFormat:=xlCSVUTF8, CreateBackup:=False
Workbooks(wksName).Close SaveChanges:=False
Wend
End Sub
uj5u.com熱心網友回復:
有幾條線可以清理,擺脫Activate并Select可以減少十分之幾秒。我看到的唯一會真正減慢 30 秒的是 Selection.Resize(NumRows2, 2).Copy. 將幾十萬個單元格移動到 Windows 剪貼板中有時會非常慢。我的建議是避開剪貼板并將值保留在 Excel 中。不要使用Copy并直接分配值。
Set wb = Workbooks.Add
wb.Worksheets(1).Cells(1, 1).Resize(NumRows2, 2).Value = Workbooks(wkbName).Worksheets(wksName).Cells(1, 1).Resize(NumRows2, 2).Value
轉載請註明出處,本文鏈接:https://www.uj5u.com/houduan/487441.html
上一篇:Python資料分析--Numpy常用函式介紹(6)--Numpy中與股票成交量有關的計算
下一篇:python拆包和封包
