[發問] 程式在跑很花時間,如何加快速度

本帖最後由 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