Excel VBA通​​过输入框填充计数器变量

Question

我将一些代码与宏记录器放在一起，并运行了一些试验和错误，它可以正常工作，但是我想添加一个输入框，该框将填充计数器值作为我的输入，而不是硬编码。

简单地说，我正在使用find函数在单个列中浏览数据。在大多数情况下，10个周期会找到所需的技巧并找到数据并清除内容。我想选择通过输入框更改计数器，而不用编辑代码。

当然很简单，但我很困惑

Sub Searchclear()
    'Search and clear Macro

    Do Until counter = 10
        counter = counter + 1
        On Error Resume Next

        Range("B2:B4000").Select
        Selection.Find(What:="Date Range ", After:=ActiveCell,
        LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Select
        Selection.ClearContents
    Loop

End Sub

以下代码与上面的代码相同，但是我尝试使用输入框

Sub Searchcleara()
    ' Search and clear Macro

    Dim counter As Integer
    counter = InputBox("Enter number of Cycles")
    Do Until counter = InputBox
        counter = counter + 1
        On Error Resume Next
        Range("B2:B4000").Select
        Selection.Find(What:="Date Range", After:=ActiveCell,
        LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Select
        Selection.ClearContents
    Loop

End Sub

Answer 1

Dim counter As Integer
counter = InputBox("Enter number of Cycles")

您信任用户在此处输入有效的号码。我会将该指令放入其自己的函数中，但主要问题在于下一行：

Do Until counter = InputBox

InputBox是一个具有 required Prompt参数的函数...您可能想做的是拥有另一个 变量（例如，cycleCounts），然后再Do Until counter = cycleCounts。

On Error Resume Next 'suppresses runtime errors
Dim cycleCounts As Integer
cycleCounts = InputBox("Enter number of cycles") 'possible type mismatch here
On Error GoTo 0 'restores runtime errors **IMPORTANT**
'note: cycleCounts is 0 if an error was raised

Dim counter As Integer
Do Until counter = cycleCounts
    counter = counter + 1
    '...
Loop

On Error Resume Next不应仅仅因为保持错误状态而快乐地执行-这会使代码的调试比必要的困难。

还有其他问题：Range.Find如果找不到所需内容，将返回Nothing，这将导致链接的.Select成员调用抛出错误91（用On Error Resume Next禁止显示）。删除.Select并将结果捕获到对象变量中：

    Dim result As Range
    Set result = Range("B2:B4000").Find(...)
    If Not result Is Nothing Then
        result.ClearContents
    End If

请注意，无需进行任何操作Select或Activate，并且错误地将错误吞咽替换为标准的If...End If流控制。