如何提高follownig代码的效率

任何人都可以帮助我优化以下简单的代码它需要永久完成执行。 也许我正在某个地方陷入无限循环。 它所做的仅仅是两个string，如果它们相等，那么就按照上面提到的单元格对位置进行混洗。

Sub sort() Dim astid As String Dim partno As String Dim FinalRow As Long Dim i, j As Integer FinalRow = Sheets("Combined Version").Range("H9000").End(xlUp).Row For i = 5 To FinalRow partno = Sheets("Combined Version").Cells(i, 7).Value For j = 5 To FinalRow astid = Sheets("Combined Version").Cells(j, 8).Value If astid = partno Then Cells(j, 8).Select Selection.Copy Range("N5").Select ActiveSheet.Paste Cells(i, 8).Select Application.CutCopyMode = False Selection.Copy Cells(j, 8).Select ActiveSheet.Paste Range("N5").Select Application.CutCopyMode = False Selection.Copy Cells(i, 8).Select ActiveSheet.Paste End If Next j Next i End Sub 

Answer 1

因为您已经将该值存储在astid var中， 所以不需要使用iterim N5作为临时存储区域 。

 Sub mysort() Dim astid As String, partno As String Dim fr As Long, i, j As Long With Sheets("Combined Version") fr = .Cells(Rows.Count, "H").End(xlUp).Row For i = 5 To fr partno = .Cells(i, 7).Value2 For j = 5 To fr astid = .Cells(j, 8).Value2 If LCase(astid) = LCase(partno) Then .Cells(j, 8) = .Cells(i, 8).Value2 .Cells(i, 8) = astid End If Next j Next i End With End Sub 

使用With … End With语句可减less重复调用以识别工作表。

使用变体arrays可以使速度更快。

Answer 2

看起来你正在扫描工作表中的每一行，为你工作的每一行！ 这可以进一步改善一个Findselect匹配的列中的所有单元格，然后您只需枚举它们。 查看Chip Pearson的FindAll函数来获得帮助。 http://www.cpearson.com/excel/FindAll.aspx

此外，您正在使用剪贴板很多不必要的。 您只需在variables的同时保存variables的值。

试试这个（使用与没有优化的“FindAll”选项相同的结构）： –

 Sub sort() Dim astid As String Dim partno As String Dim FinalRow As Long Dim i, j As Integer Dim Cell_I As String Dim Cell_J As String Dim ws As Worksheet 'Don't update the screen until the end Application.ScreenUpdating = False Set ws = Sheets("Combined Version") FinalRow = ws.Range("H9000").End(xlUp).Row For i = 5 To FinalRow partno = ws.Cells(i, 7).Value For j = 5 To FinalRow astid = ws.Cells(j, 8).Value If astid = partno Then Cell_I = ws.Cells(i, 8).Value Cell_J = ws.Cells(j, 8).Value ws.Cells(j, 8).Value = Cell_I ws.Cells(i, 8).Value = Cell_J End If Next j Next i Set ws = Nothing Application.ScreenUpdating = True End Sub