返回列表 上一主題 發帖

[發問] 可否幫忙改善迴圈速度

[發問] 可否幫忙改善迴圈速度

程式碼下,檔案中請點擊"另存i-Link路徑檔"執行巨集,謝謝幫忙~
  1. Sub 匯出製程至路徑檔()

  2.     Application.ScreenUpdating = False
  3.     Application.DisplayAlerts = False
  4.     If Cells(11, "A") Like "外觀" Then       '外觀
  5.                 Cells(11, "F").Value = "D,1,1"
  6.                 Cells(11, "G").Value = "D,1,2"
  7.                 Cells(11, "H").Value = "D,1,3"
  8.                 Cells(11, "I").Value = "D,1,4"
  9.                 Cells(11, "J").Value = "D,1,5"
  10.     End If
  11.    
  12.     lastRow = Sheets("製程檢查記錄表").Columns(2).Find(What:="", LookIn:=xlValues, _
  13.     SearchDirection:=xlNext, AFTER:=Range("B12")).Row
  14.    
  15.     For I = 12 To lastRow              'Range("A12").End(xlDown).Row
  16.             If Cells(I, "B") <> "" Then
  17.                 Cells(I, "F").Value = "D," & Cells(I, "A").Value + 1 & ",1"
  18.                 Cells(I, "G").Value = "D," & Cells(I, "A").Value + 1 & ",2"
  19.                 Cells(I, "H").Value = "D," & Cells(I, "A").Value + 1 & ",3"
  20.                 Cells(I, "I").Value = "D," & Cells(I, "A").Value + 1 & ",4"
  21.                 Cells(I, "J").Value = "D," & Cells(I, "A").Value + 1 & ",5"
  22.             Else
  23.             End If
  24.     Next
  25.    
  26.     For I = 47 To Range("A47").End(xlDown).Row
  27.         If Cells(I, "B") <> "" Then
  28.             If Cells(I, "B") <> "" Then
  29.                 Cells(I, "F").Value = "D," & Cells(I, "A").Value + 1 & ",1"
  30.                 Cells(I, "G").Value = "D," & Cells(I, "A").Value + 1 & ",2"
  31.                 Cells(I, "H").Value = "D," & Cells(I, "A").Value + 1 & ",3"
  32.                 Cells(I, "I").Value = "D," & Cells(I, "A").Value + 1 & ",4"
  33.                 Cells(I, "J").Value = "D," & Cells(I, "A").Value + 1 & ",5"
  34.             Else
  35.             End If
  36.         End If
  37.     Next
  38.    
  39.     Application.ScreenUpdating = True
  40.     Application.DisplayAlerts = True
  41.     Range("A11").Select
  42.    
  43.     Dim xlFolder As String
  44.     xlFolder = ThisWorkbook.Path & "\" & "i-Link 路徑檔"        '指定資料夾
  45.     If Dir(xlFolder, vbDirectory) = "" Then MkDir xlFolder

  46.     Dim xPath As String
  47.     xPath = Application.ActiveWorkbook.Path
  48.     Application.ScreenUpdating = False
  49.     Application.DisplayAlerts = False
  50.     Titlename = ThisWorkbook.Sheets("製程檢查記錄表").Range("H4").Value
  51.     With ActiveSheet
  52.        .Copy
  53.        ActiveSheet.DrawingObjects.Delete
  54.        X = InputBox("請輸入檔名!!", "另存新檔", Titlename & " " & "製程(路徑檔)")
  55.         If X <> "" Then
  56.             Application.ActiveWorkbook.SaveAs Filename:=xlFolder & "\" & X, _
  57.             FileFormat:=xlExcel8
  58.             MsgBox "儲存成功!"
  59.         ElseIf X = "" Then
  60.             MsgBox "已取消儲存!!!"
  61.         End If
  62.        Application.ErrorCheckingOptions.BackgroundChecking = False
  63.        Application.ActiveWorkbook.Close False
  64.     End With
  65.    
  66.     For I = 11 To Range("B11").End(xlDown).Row
  67.         If Cells(I, "A") <> "" Then
  68.             Cells(I, "F").Value = ""
  69.             Cells(I, "G").Value = ""
  70.             Cells(I, "H").Value = ""
  71.             Cells(I, "I").Value = ""
  72.             Cells(I, "J").Value = ""
  73.         ElseIf Cells(I, "A") = "" Then
  74.             Exit For
  75.         End If
  76.     Next
  77.     For I = 47 To Range("A47").End(xlDown).Row
  78.         If Cells(I, "A") <> "" Then
  79.             Cells(I, "F").Value = ""
  80.             Cells(I, "J").Value = ""
  81.             Cells(I, "H").Value = ""
  82.             Cells(I, "I").Value = ""
  83.             Cells(I, "J").Value = ""
  84.         ElseIf Cells(I, "A") = "" Then
  85.             Exit For
  86.         End If
  87.     Next
  88.    
  89.     Application.DisplayAlerts = True
  90.     Application.ScreenUpdating = True
  91.    
  92.    
  93. End Sub
複製代碼
test2.rar (40.14 KB)

本帖最後由 n7822123 於 2019-6-11 23:56 編輯

回復 1# s13030029

這段程式!? 判斷重複....且跑了100多萬列...........

    For I = 47 To Range("A47").End(xlDown).Row
        If Cells(I, "B") <> "" Then
            If Cells(I, "B") <> "" Then
                Cells(I, "F").Value = "D," & Cells(I, "A").Value + 1 & ",1"
                Cells(I, "G").Value = "D," & Cells(I, "A").Value + 1 & ",2"
                Cells(I, "H").Value = "D," & Cells(I, "A").Value + 1 & ",3"
                Cells(I, "I").Value = "D," & Cells(I, "A").Value + 1 & ",4"
                Cells(I, "J").Value = "D," & Cells(I, "A").Value + 1 & ",5"
            Else
            End If
        End If
    Next

時間主要卡在你程式碼27~38列的部分,

因為你給的檔案從A47以後都沒資料,所以不知道這段程式到底要幹嘛!

迴圈會重47列跑到1048576........且儲存格都是空白,等於白跑了100多萬列!

如果你把這段註解掉,會發現速度馬上提昇。
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 2# n7822123
我的表格會依檢驗項目如果超過21項,也就是第一張表填滿了,就會自動增加第二張表格在下面,繼續把資料填上,所以現在47列開始才會是空的

附檔: test2.rar (56.35 KB)

TOP

其實不應該用xlDown對不對?

TOP

本帖最後由 n7822123 於 2019-6-12 09:00 編輯

回復 4# s13030029


恩恩,應該每張表格都給他一個範圍去跑就好了

舉例來說你第2張表格會從A47 到A67,就把你的I固定從 47到67就可以了

如果會有第3張表格與第4張表格也類似處理,不太可能跑到1048576列的....
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2019-6-12 09:19 編輯

回復 5# n7822123


可根據一些表格固定會出現字眼,先判斷會有幾個表格,再設立範圍

舉例 :
每張表格固定跑20列(第一張從12跑到31),有30張表格(變數T),
假設每張表格的儲存格位置相差37列,可以改成如下

For T=1 to 30  '假設有30張表格
    For I = T*37-25 To T*37-6  '第一列與最後一列依據第T張表格做變動
            If Cells(I, "B") <> "" Then
                Cells(I, "F").Value = "D," & Cells(I, "A").Value + 1 & ",1"
                Cells(I, "G").Value = "D," & Cells(I, "A").Value + 1 & ",2"
                Cells(I, "H").Value = "D," & Cells(I, "A").Value + 1 & ",3"
                Cells(I, "I").Value = "D," & Cells(I, "A").Value + 1 & ",4"
                Cells(I, "J").Value = "D," & Cells(I, "A").Value + 1 & ",5"
            Else
            End If
    Next I
Next T

當然這還是可以優化的,用陣列處理可以更快。
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 6# n7822123


End(xlDown) 可適用於 確定有資料 的情況下,無資料會跑到最末列

使用前要先判斷是否有資料
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 7# n7822123
原來如此~~~非常感謝~~~

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事,就等於壽命有多長。因此必須與時間競爭,切莫使時日空過。
返回列表 上一主題