Question

我有一个电子表格模型，我经常需要扫描一个输入参数。我以前使用Excel的内置表函数，但这给我带来了问题，所以现在我只使用一些手动完成扫描的VBA代码。 VBA代码运行一个循环，它改变输入参数，调用Application.Calculate，存储结果并重复。

我发现如果从Forms控件按钮运行这个宏，它可以正常工作。但是，如果我从ActiveX命令按钮运行宏，它有时只能正常工作。基本上如果单击按钮后我根本不移动鼠标，宏运行正常。但是如果我在循环结束之前移动鼠标，那么从那时起结果将是错误的。我可以在工作表上使用任一版本的按钮，但如果我想在userform上使用按钮，我需要使用ActiveX类型。但是当循环运行时我无法移动鼠标。

是否有其他人遇到此问题并找到了解决方法？

这是我从网上获得并略微修改的宏：

Sub IterateTables()

Dim rngTable As Range
Dim rngRowCell As Range     'input variable cell location
Dim rngColCell As Range     'input variable cell location
Dim rngFormula As Range     'formula cell at top-left

Dim varRowSet As Variant    'set of input data on top row. 1D vector
Dim varColSet As Variant    'set of input data on left column. 1D vector
Dim varResults() As Variant 'Why parenthesis? Expect an 2D array? Why no parens for two above?

Dim nRows As Long
Dim nCols As Long
Dim j As Long
Dim k As Long

Dim varStartRowVal As Variant   'Initial value
Dim varStartColVal As Variant   'Iniitial value
Dim varFirstVal As Variant      'Initial value

Dim lCalcMode As Long
Dim blCalculated As Boolean
Dim dTime As Double
'
' get the location of what-if table and its formula cell
'Set rngTable = ActiveCell.CurrentRegion    ' expand active cell to the current region
Set rngTable = Sheets("Sheet1").Range("E7:H12")
Set rngFormula = rngTable.Cells(1, 1)   ' Top-Left corner
nRows = rngTable.Rows.Count - 1         ' number of rows in the Column of what-if values
nCols = rngTable.Columns.Count - 1      ' number of columns in the row of what-if values
'
' get the row and column input cells using RefEdit on userform
'With ufIterTable
 '   .RefEditRow.Value = ""
  '  .RefEditCol.Value = ""
   ' .Show                   'Modal or non-modal userform?   ShowModal = True
    'If ufIterTable.RefEditRow.Value <> "" Then Set rngRowCell = Range(.RefEditRow.Value)
    'If ufIterTable.RefEditCol.Value <> "" Then Set rngColCell = Range(.RefEditCol.Value)
'End With

'HArd code insted of userform selection
Set rngRowCell = Range("F3")
Set rngColCell = Range("G3")

' if 2-D and we have got the row and column cells then proceed
If nRows > 0 And nCols > 0 And Not rngRowCell Is Nothing And Not rngColCell Is Nothing Then
    dTime = MicroTimer  'Start timer
    '
    ' create output results array
    ReDim varResults(1 To nRows, 1 To nCols)
    '
    ' get row and column arrays of what-if values
    varRowSet = rngFormula.Offset(0, 1).Resize(1, nCols).Value2
    varColSet = rngFormula.Offset(1, 0).Resize(nRows, 1).Value2
    '
    ' set environment
    Application.ScreenUpdating = False
    lCalcMode = Application.Calculation
    If Application.Calculation <> xlCalculationManual Then Application.Calculation = xlCalculationManual
    '
    ' can only skip initial values if workbook is calculated at start
    If Application.CalculationState = xlDone Then
        blCalculated = True
    Else
        blCalculated = False
    End If
    '
    ' Record initial start values for use at end
    varStartRowVal = rngRowCell.Value2
    varStartColVal = rngColCell.Value2
    varFirstVal = rngFormula.Value2
    '
    ' calculate result for each what-if values pair
    For j = 1 To nRows
        For k = 1 To nCols
            If blCalculated And varRowSet(1, k) = varStartRowVal And varColSet(j, 1) = varStartColVal Then
                '
                ' if what-if value pair is the same as the start values then skip recalc
                 varResults(j, k) = varFirstVal
            Else
                Application.StatusBar = "What-If Table Row " & j & " Column " & k       ' show calc status in the status bar
                '
                ' set values for this iteration, recalc, store result
                rngRowCell.Value2 = varRowSet(1, k)
                rngColCell.Value2 = varColSet(j, 1)
                Application.Calculate                   'Full calculate?
                varResults(j, k) = rngFormula.Value2
            End If
        Next k
    Next j
    '
    ' reset status bar
    Application.StatusBar = False
    '
    ' put results back to sheet
    rngFormula.Offset(1, 1).Resize(nRows, nCols) = varResults       'Write results array to sheet
    '
    ' reset both input cells back to initial values & recalc
    rngRowCell.Value2 = varStartRowVal
    rngColCell.Value2 = varStartColVal
    Application.Calculation = lCalcMode
    Application.Calculate
    '
    ' timer message
    dTime = Int((MicroTimer - dTime) * 1000) / 1000     'End timer
    MsgBox "Time for " & nRows * nCols & " Iterations: " & dTime & " Seconds"
End If

End Sub

excel activex命令按钮

0 个答案: