单独步行穿过标记的细胞

Question

我的项目有一个伸展目标，超出了我当前的能力，但我希望这里有人能让我走上正确的轨道。我有以下代码：

Public ErrorCount As Integer 

Sub GeneralFormat() 
    ErrorCount = 0 
    VLookup 
    MacroFillAreas 
    color 
    NonZeroCompare 
    MustBe 
    MsgBox ("Number of Errors" & CStr(ErrorCount)) 
End Sub 

我也有代码的以下部分：

Sub NonZeroCompare() 
Dim i As Long 
For i = 5 To 1000 Step 1 
    If Range("AK" & i).Value = "On" Then 
     If Range("AL" & i).Value = 0 And Range("AM" & i).Value = 0 Then 
      Range("AL" & i, "AM" & i).Interior.ColorIndex = 6 
      ErrorCount = ErrorCount + 1 
     End If 
    ElseIf Range("BC" & i).Value = 0 And Range("BD" & i).Value = 0 Then 
     Range("BC" & i, "BD" & i).Interior.ColorIndex = 6 
     ErrorCount = ErrorCount + 1 
    ElseIf Range("EJ" & i).Value = "On" Then 
     If Range("EK" & i).Value = 0 And Range("EL" & i).Value = 0 Then 
      Range("EK" & i, "EL" & i).Interior.ColorIndex = 6 
      ErrorCount = ErrorCount + 1 
     End If 
    ElseIf Range("ES" & i).Value = 0 And Range("ET" & i).Value = 0 Then 
     Range("ES" & i, "ET" & i).Interior.ColorIndex = 6 
     ErrorCount = ErrorCount + 1 
    ElseIf Range("FG" & i).Value = 0 And Range("FH" & i).Value = 0 Then 
     Range("FG" & i, "FH" & i).Interior.ColorIndex = 6 
     ErrorCount = ErrorCount + 1 
    End If 
Next i 
End Sub 

我想要的效果是让用户可以跳转到有利于每个单元“的ErrorCount ”。我的工作簿中有数千个单元需要管理，因此能够在检查时跳出错误将会很好。如果可以通过键盘上的一个按键完成，它会更好，但按钮也可以工作。

有关如何执行此类操作的任何想法？另外，难度级别？关于从何种类型的功能开始的资源？最后一个问题：任何可以使用的原生特性都可以编码，不需要硬核编码？

Answer 1

这里有一种方法可以处理您的需求。

首先，我们可以持有一个Dictionary对象，该对象持有对单元格位置的引用，而不是只保存错误数量的计数。使用这个对象，我们可以检查它的总数错误，位置等。

我将在下面显示一个（相对简单）的实现。 （如果您不熟悉Dictionary对象，请进行一些研究。基本上，它拥有唯一的键和相应的值）。在我的情况下，我选择将错误单元格的地址存储为密钥，并且只是将空字符串存储为值。

首先，我写了一个函数来返回保存错误的字典对象。在简单的实现中，我有一个固定的范围，并且存储在任何具有文本“Abc”的单元格的地址中。接下来，我写了一个帮助器函数，它返回对象数量的计数（这很简单，您并不需要辅助函数，但如果进行多个调用或者如果您将添加更多的定制逻辑）。

最后，两个子例程完成最终请求：遍历错误。第一个例程'TraverseErrors goes through the dictionary and "visits" each of the addresses. This then yields to a DoEvents call which allows the user to do what they need to. The JumpAhead`例程告诉系统用户全部完成。

将键盘快捷键连接到JumpAhead方法很有帮助。为此，在Excel工作簿中，按ALT + F8打开宏窗口。选择JumpAhead例程，然后单击对话框中的Options按钮。这使您可以输入一个字母，并在按住CTRL键的同时运行该宏。 （我选择了字母e，所以CTRL + e允许我在进行更改后跳到前面）。

有一些挑战需要考虑。例如，我的单元地址没有参考表。因此，如果这个宏切换工作表，你可能会遇到一些麻烦。

让我知道任何问题。

Dim oDictCellsWithErrors As Object 
Dim bContinue As Boolean 

Private Function GetErrorsDict() As Object 
    Dim rData As Range 
    Dim rIterator As Range 

    'This helper function returns the dictionary object containing the errors 
    'If it's already been populated 
    'If not, it creates then returns the object 

    If Not oDictCellsWithErrors Is Nothing Then 
     Set GetErrorsDict = oDictCellsWithErrors 
     Exit Function 
    End If 

    'Some logic to create a dictionary of errors 
    'In my case, I'm adding all cells that have the text "Abc" 
    'Your logic should differ 

    Set rData = Sheet1.Range("A2:A15") 
    Set oDictCellsWithErrors = CreateObject("Scripting.Dictionary") 

    For Each rIterator In rData 
     If rIterator.Value = "Abc" Then 
      If Not oDictCellsWithErrors.exists(rIterator.Address) Then 
       oDictCellsWithErrors(rIterator.Address) = "" 
      End If 
     End If 
    Next rIterator 

    Set GetErrorsDict = oDictCellsWithErrors 
End Function 

Private Function CountErrors() As Integer 
    'This function returns the number of errors in the document 
    CountErrors = GetErrorsDict().Count 
End Function 

Sub TraverseErrors() 
    Dim oDict As Object 
    Dim sKey As Variant 

    Set oDict = GetErrorsDict() 

    For Each sKey In oDict.keys 
     bContinue = False 
     Sheet1.Range(sKey).Activate 

     Do Until bContinue 
      DoEvents 
     Loop 
    Next sKey 

    MsgBox "No more errors" 
End Sub 

Sub JumpAhead() 
    bContinue = True 
End Sub