卡在每個循環 - 無休止地搜索匹配

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