[算表] VBA跑迴圈很慢如何改善

看板Office作者tina1688時間6年前 (2019/10/29 20:31)推噓0(0推 0噓 3→)

留言3則, 1人參與討論串1/1

又來請教大大，要將list檔案(53筆data) 彙整至兩個不同檔案(超過1300筆data，其他欄位有填滿和公式格式設定) 但一個檔案就要跑5分鐘@@，有辦法修改讓他跑快一點嗎? 程式碼如下，附上VBA檔案&File連結，會比較清楚&可編輯 https://reurl.cc/D1j3GN 再麻煩解惑，感謝喔~ Sub MFile() Dim X As Long Dim i As Integer M = "MFile" OnLineList = "list" '如果I欄(上線清單)=1， Windows(OnLineList).Activate Sheets("資料合併整理for單列").Range("A2").Select For i = 2 To ActiveCell.SpecialCells(xlLastCell).Row If Windows(OnLineList).ActiveSheet.Range("I" & i) = 1 Then Windows(M).Activate Sheets("2019").Range("I5").Select For k = 5 To ActiveCell.SpecialCells(xlLastCell).Row If Windows(M).ActiveSheet.Range("I" & k) = Windows(OnLineList).ActiveSheet.Range("A" & i) And _ Windows(M).ActiveSheet.Range("AJ" & k) = "" Then Windows(M).ActiveSheet.Range("AJ" & k) = Windows(OnLineList).ActiveSheet.Range("B" & i) Windows(M).ActiveSheet.Range("AQ" & k) = Windows(OnLineList).ActiveSheet.Range("C" & i) Windows(M).ActiveSheet.Range("AH" & k) = Windows(OnLineList).ActiveSheet.Range("F" & i) Windows(M).ActiveSheet.Range("AJ" & k).Interior.Color = 15773696 Windows(M).ActiveSheet.Range("AQ" & k).Interior.Color = 15773696 Windows(M).ActiveSheet.Range("AH" & k).Interior.Color = 15773696 Windows(OnLineList).ActiveSheet.Range("B" & i).Interior.Color = 15773696 Windows(OnLineList).ActiveSheet.Range("C" & i).Interior.Color = 15773696 Windows(OnLineList).ActiveSheet.Range("F" & i).Interior.Color = 15773696 Else If Windows(M).ActiveSheet.Range("I" & k) = Windows(OnLineList).ActiveSheet.Range("A" & i) And _ Windows(M).ActiveSheet.Range("AJ" & k) <> "" Then Windows(M).ActiveSheet.Range("AJ" & k).Interior.Color = 1111111 Windows(M).ActiveSheet.Range("AQ" & k).Interior.Color = 1111111 Windows(M).ActiveSheet.Range("AH" & k).Interior.Color = 1111111 Windows(OnLineList).ActiveSheet.Range("B" & i).Interior.Color = 1111111 Windows(OnLineList).ActiveSheet.Range("C" & i).Interior.Color = 1111111 Windows(OnLineList).ActiveSheet.Range("F" & i).Interior.Color = 1111111 End If End If Next End If Next End Sub -- Sent from my Windows -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 180.204.69.53 (臺灣) ※ 文章網址: https://www.ptt.cc/bbs/Office/M.1572352279.A.C7D.html