標題: [發問] 程式在跑很花時間,如何加快速度 [打印本頁]

---

作者: anny8888    時間: 2013-10-22 17:36     標題: 程式在跑很花時間,如何加快速度

本帖最後由 anny8888 於 2013-10-22 17:37 編輯

程式在跑時會在第二段的部份花很多時間, 因為每個 X 都需要確認  550個相同的Q.....
可否有方法可以加快速度.......

For q = 2 To 550
If Workbooks("UT_weekly").Sheets(n1).Cells(x, 4) <> "" And Workbooks("UT_weekly").Sheets(n1).Cells(x, 4).Value = Workbooks("mergertosheet3").Sheets(2).Cells(q, 7).Value Then
Workbooks("UT_weekly").Sheets(n1).Cells(x, 17) = Workbooks("mergertosheet3").Sheets(2).Cells(q, 9)
Workbooks("UT_weekly").Sheets(n1).Cells(x, 18) = Workbooks("mergertosheet3").Sheets(2).Cells(q, 8)
End If
Next
Next


======================================================
Sub creform()
Dim x As Integer, y As Integer, q As Integer


Windows("UT_weekly").Activate
For n1 = 1 To 2 Step 1
Sheets(n1).Select
n = Sheets(n1).UsedRange.Rows.Count
'MsgBox n

Columns("C:C").ColumnWidth = 18
Range("N1").FormulaR1C1 = "Product"
Range("O1").FormulaR1C1 = "account"
Range("P1").FormulaR1C1 = "FSE/FPE"
Range("Q1").FormulaR1C1 = "Manager"
Range("R1").FormulaR1C1 = "DFS name"

For x = 2 To [A2].End(xlDown).Row + 5 Step 1
For y = 2 To 100
If Workbooks("UT_weekly").Sheets(n1).Cells(x, 4) <> "" And Workbooks("UT_weekly").Sheets(n1).Cells(x, 2).Value = Workbooks("mergertosheet3").Sheets(2).Cells(y, 1).Value Then
Workbooks("UT_weekly").Sheets(n1).Cells(x, 14) = Workbooks("mergertosheet3").Sheets(2).Cells(y, 2)
Workbooks("UT_weekly").Sheets(n1).Cells(x, 15) = Workbooks("mergertosheet3").Sheets(2).Cells(y, 4)
Workbooks("UT_weekly").Sheets(n1).Cells(x, 16) = Workbooks("mergertosheet3").Sheets(2).Cells(y, 3)
End If
Next
'=============================================================================================
For q = 2 To 550
If Workbooks("UT_weekly").Sheets(n1).Cells(x, 4) <> "" And Workbooks("UT_weekly").Sheets(n1).Cells(x, 4).Value = Workbooks("mergertosheet3").Sheets(2).Cells(q, 7).Value Then
Workbooks("UT_weekly").Sheets(n1).Cells(x, 17) = Workbooks("mergertosheet3").Sheets(2).Cells(q, 9)
Workbooks("UT_weekly").Sheets(n1).Cells(x, 18) = Workbooks("mergertosheet3").Sheets(2).Cells(q, 8)
End If
Next

Next


'==============================================================================================================
    For x = 2 To [A2].End(xlDown).Row + 5 Step 1

If Workbooks("UT_weekly").Sheets(n1).Cells(x, 4) = "" And Workbooks("UT_weekly").Sheets(n1).Cells(x, 3) <> "" Then
    Rows(x).Font.Bold = True
   
End If
Next

'==========================================================


Next



End Sub

---

作者: sunnyso    時間: 2013-10-22 18:41

把資料讀入陣列,處理後再寫入

---

作者: anny8888    時間: 2013-10-23 09:15

回復 2# sunnyso


   請問大大應該如何做....不知要如何先讀入陣列....

---

作者: c_c_lai    時間: 2013-10-23 10:25

回復 3# anny8888
你不附上檔案，別人如何教你？

---

作者: anny8888    時間: 2013-10-24 10:03

回復 4# c_c_lai


   抱歉!! 原始檔有人名,不知會不會有個資法問題, 附件為修改的資料, 原始檔案有300 筆左右.

  先謝謝了...

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)