卡在每个循环 - 无休止地搜索匹配

Question

我是VBA的新手 - 完全是外语，尽我所能理解。

我想写一段代码，这将帮助我在一个工作表中基于另一个工作表中的表格中的单元格的内部颜色格式的颜色代码项目。我已经在基本级别上实现了它，但当用于颜色编码的单元格的值无法与Sheet2中的表中的任何值匹配时，它们就已经脱落。理想情况下，我希望在这种情况下执行的操作只是向下移动到单元格1行并继续循环，但实际发生的是它在Sheet2中的表格中循环寻找匹配。我尝试了各种Else和ElseIf语句来试图阻止这一点，但是没有一个会导致期望的结果。我写的代码（得很厉害，我敢肯定）低于：

---

Sub Colour_Code_Cells() 

    Dim xlRange As Range 
    Dim xlCell As Range 
    Dim xlSheet As Worksheet 
    Dim formatSheet As Worksheet 
    Dim formatRange As Range 
    Dim formatCell As Range 

     Set xlSheet = ActiveWorkbook.Worksheets("colourcode") 
     Set xlRange = xlSheet.Range("A1:A10") 
     Set formatSheet = ActiveWorkbook.Worksheets("Sheet1") 
     Set formatCell = formatSheet.Range("A2") 

      formatCell.Activate 

      Do Until Selection.Value = "" 

       For Each xlCell In xlRange 

         If xlCell.Value = ActiveCell.Value Then 
         ActiveCell.Interior.Color = xlCell.Interior.Color 
         ActiveCell.Offset(1, 0).Select 

         End If 

       Next xlCell 

      Loop 


End Sub 

---

任何建设性的提示，将最感激地接受。你如何告诉它停止查看每个Next xlCell，如果它已经看过一次？

提前感谢

Answer 1

主要的问题是你有ActiveCell.Offset(1, 0).Select If语句里面，所以如果它没有找到在xlRange比赛不会移动到下一个单元格，并继续检查相同细胞。因此，无尽的循环。

选择并激活会减慢代码速度，通常不需要，应该避免。

代码的一个小的重构将使它更快，更可靠。

这将一个循环中使用的匹配找到匹配做到这一点：

Sub Colour_Code_Cells() 

    Dim xlRange As Range 
    Dim xlCell As Range 
    Dim xlSheet As Worksheet 
    Dim formatSheet As Worksheet 
    Dim formatRange As Range 
    Dim formatCell As Range 
    Dim t As Long 

    Set xlSheet = ActiveWorkbook.Worksheets("colourcode") 
    Set xlRange = xlSheet.Range("A1:A10") 
    Set formatSheet = ActiveWorkbook.Worksheets("Sheet1") 
    With formatSheet 
     For Each formatCell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) 
      t = 0 
      On Error Resume Next 
      t = Application.WorksheetFunction.Match(formatCell, xlRange, 0) 
      On Error GoTo 0 

      If t > 0 Then 
       formatCell.Interior.Color = xlRange(t).Interior.Color 
      End If 
     Next formatCell 
    End With 


End Sub