单独穿过标记的细胞

我的项目有一个伸展的目标,超出了我目前的能力,但是我希望这里有人能把我放在正确的轨道上。 我有以下代码:

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”的每个单元格。 我的工作簿中有数以千计的单元可以pipe理,所以能够跳到错误审查将是伟大的。 如果可以用键盘上的一个按键来完成,效果会更好,但button也可以。

任何想法如何执行这样的事情? 另外,难度级别? 任何资源在哪里开始这种types的function? 最后一个问题:任何本地function,我可以在代码中使用,不需要硬核编码?

这里有一个方法可以处理你的需求。

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

我将在下面展示一个(相对简单的)实现。 (如果你不熟悉Dictionary对象,做一些研究,基本上它有一个唯一的键和相应的值)。 在我的情况下,我select存储一个错误单元格的地址作为键,我只是存储一个空白string作为值。

首先,我写了一个函数来返回包含错误的字典对象。 在简单的实现中,我有一个固定的范围,并且存储在任何有“Abc”文本的单元格的地址中。

接下来,我编写了一个辅助函数,它返回一个对象数量的计数(这很简单,你不需要辅助函数,但是如果多次调用,或者你会添加更多的自定义逻辑,它可能会简化) 。

最后,两个子例程完成最终请求:遍历错误。 第一个例程“TraverseErrors” goes through the dictionary and "visits" each of the addresses. This then yields to a 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方法JumpAhead 。 为此,在Excel工作簿中,按ALT + F8打开macros窗口。 selectJumpAhead例程,然后单击对话框中的Optionsbutton。 这可以让你input一个字母,当按下CTRL键的同时,运行macros。 (我select了字母e,所以CTRL + e让我跳跃前进,一旦我做了改变)。

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

让我知道任何问题。

 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