优化循环遍历数组的行和列

时间:2015-11-21 09:32:46

标签: vba excel-vba excel

我有一个大约400列和30行的数组 我想浏览每一列中的所有列和每一行,并测试每个单元格的单元格,如果它包含负数,如果它存在,我想复制单元格本身及其上方的某些单元格另一张。

我使用2个标准“for-loop”完成了这项工作,但是它需要花费很多时间,并且每个单元格都有超过10种不同的测试。

我想知道是否有人知道更有效的方法,例如使用“for each”语句......我一直在尝试这个没有运气 -

 Set FinalSht = ActiveWorkbook.Worksheets("Final")
    Cnter = FinalSht.Cells(5, FinalSht.Columns.Count).End(xlToRight).Column
    Rowter = FinalSht.Cells(FinalSht.Rows.Count, "B").End(xlUp).Row

    Set AnRe = ActiveWorkbook.Worksheets("Anomaly")
    AnRe.Cells.ClearContents

    Set SRng = FinalSht.Range(FinalSht.Cells(5, 3), FinalSht.Cells(14, Cnter))

    RowCount = 0
    ColCount = 0

    For Each RowRng In SRng.Rows
    RowCount = RowCount + 1

             For Each ColRng In SRng.Columns
             ColCount = ColCount + 1
             Select Case True
                Case FinalSht.Cells(RowRng.Rows, ColRng.Columns) < 0
                With AnRe
                     .Cells(RowCount, ColCount).Value = FinalSht.Cells(RowRng.Rows, ColRng.Columns).Value
                End With

                  End Select

                Next ColRng


 Next RowRng

感谢我能得到任何帮助......

1 个答案:

答案 0 :(得分:0)

要检查代码是否缓慢的一些常规事项:

声明您的变量以适合您的数据,请参阅here for more info

摆脱未使用的变量,代码部分

查看this有关如何使用for each循环的一些想法(每个循环不需要两个循环来遍历范围内的所有单元格)。 For each通常比for循环更快。

你真的需要优化你的循环:确保你只循环你真正需要的东西。

此外,优化循环内的任何内容。确保你只在循环中做任何必要的事情,因为这才是最重要的。

关于您的代码:

基本上你的代码很慢,因为有两件事。

Cnter = FinalSht.Cells(5, FinalSht.Columns.Count).End(xlToRight).Column

xlToRight让它循环通过16000+列,而不仅仅是400.大差异。我告诉你的其余部分只是速度增益的1%。在调试代码时,使用F8逐步执行,然后使用watch或locals窗口。 More info here.

另一个问题是有两个for each循环,而不仅仅是你实际需要的循环。

以下代码运行不到一秒钟。希望这会有所帮助。

Sub test()

Dim Finalsht As Worksheet
Dim AnEr As Worksheet
Dim Cnter As Integer
Dim Rownter As Long
Dim SRng As Range
Dim myCell As Range

  Set Finalsht = ActiveWorkbook.Worksheets("Final")
  Cnter = Finalsht.Cells(5, Finalsht.Columns.Count).End(xlToLeft).Column
  Rowter = Finalsht.Cells(Finalsht.Rows.Count, 2).End(xlUp).Row

  Set AnRe = ActiveWorkbook.Worksheets("Anomaly")
  AnRe.Cells.ClearContents

  Set SRng = Finalsht.Range(Finalsht.Cells(5, 3), Finalsht.Cells(14, Cnter))

  For Each myCell In SRng
    Select Case True
      Case myCell.Value < 0
        With AnRe
             .Cells(myCell.Row, myCell.Column).Value = myCell.Value
        End With

      End Select

  Next myCell

End Sub