vba - 修改用户表单以在多个工作表上工作

Question

过去几周的大部分时间里，我都在努力制作一些用户表单(这不是我的强项之一)。使用我的预期用户表单，用户可以在电子表格上选择他们想要的任何值(例如 Assets 价格)，然后应用微调器，这模拟了这些 Assets 价格的增加/减少 % 等，然后他们可以观察如何这会影响业务的各个方面。然后他们有两个按钮，一个可以保留调整后的值，另一个可以重置值。

到目前为止，我有一个似乎可以在各种工作表上工作的用户表单，但所选范围必须是连续的，并且一个在这里有很大帮助(请参阅我自己的上一个问题)，它非常适用于不连续的选择，但是它们必须在相同的工作表。但是，理想情况下，我希望能够在多个工作表中选择多个不连续的范围并能够对其进行编辑。我被可靠地告知范围变量只能引用特定工作表上的范围，我认为这是我出错的地方。

适用于非连续范围的代码如下，老实说，我不能因为我需要从这里得到很多帮助，而且我还没有完全整理好它，但我真的不能把它归功于它，任何人都可以建议我如何编辑或修改它以同时跨多个工作表和非连续范围工作？

打开用户表单；

Public myRange As Range, myArea As Range
Public myCopy As Variant
Public i As Long, numAreas As Long
Public pvar As Double

Sub Button2_Click()
Spinner.Show
End Sub

用户表单:

Option Explicit

'on opening userform this sets the variables

Private Sub UserForm_Activate()

pvar = 1

Set myRange = Selection

    numAreas = myRange.Areas.Count
    If numAreas = 1 Then
        myCopy = myRange.Value
    Else
        ReDim myCopy(1 To numAreas)
        For i = 1 To numAreas
            myCopy(i) = myRange.Areas(i).Value
        Next i
    End If
End Sub

'Useful Subs

Sub RestoreVals(R As Range, V As Variant)
    Dim A As Range
    Dim i As Long, n As Long
    n = R.Areas.Count
    If n = 1 Then
        R.Value = V
    Else
        For i = 1 To n
            R.Areas(i).Value = V(i)
        Next i
    End If
End Sub

Sub Multiply(R As Range, p As Double)
    Dim c As Range
    For Each c In R.Cells
        c.Value = p * c.Value
    Next c
End Sub

'Spin Up button

Private Sub SpinButton1_SpinUp()

Dim myRange As Range, myCopy As Variant

    Set myRange = Selection

'Reset Values so that pvar is * by the right values

    CopyVals myRange, myCopy
    Multiply myRange, (1 / pvar)

'Now * by pvar

    CopyVals myRange, myCopy
    pvar = pvar + UpBox.Value / 100
    Multiply myRange, pvar

End Sub

' Spin Down button

Private Sub SpinButton1_SpinDown()

Dim myRange As Range, myCopy As Variant

    Set myRange = Selection

'Reset Values so that pvar is * by the right values

    CopyVals myRange, myCopy
    Multiply myRange, (1 / pvar)

'Now * by pvar

    CopyVals myRange, myCopy
    pvar = pvar - DownBox.Value / 100
    Multiply myRange, pvar

End Sub

'Button to return to starting values

Public Sub DefaultButton_Click()

If numAreas = 1 Then
        myRange.Value = myCopy
    Else
        For i = 1 To numAreas
            myRange.Areas(i).Value = myCopy(i)
        Next i
    End If

End Sub

'button to maintain adjusted values

Private Sub CommandButton1_Click()

UserForm3.Show

End Sub

Answer 1

作为概念证明，我创建了以下用户表单。在编辑器中，我将 ShowModal 设置为 False。这很重要，因为它允许用户在显示表单时切换到不同的工作表。它看起来像这样:



以下代码显示了一种允许用户在单独的工作表上选择可能不连续的范围，通过乘法因子修改它们，然后恢复原始值的方法:

Option Explicit
Dim valCopies As Collection
Dim ranges As Collection

Private Sub UserForm_Initialize()
    Dim r As Range
    tbChangeFactor.Value = "1.0"
    Set ranges = New Collection
    Set valCopies = New Collection
    For Each r In Selection.Areas
        ranges.Add r
        valCopies.Add r.Value
    Next r
End Sub

Private Sub btnChange_Click()
    Dim r As Range, c As Range, p As Double

    Application.ScreenUpdating = False
    p = tbChangeFactor.Value
    For Each r In ranges
        For Each c In r.Cells
            c = c * p
        Next c
    Next r
    Application.ScreenUpdating = True
End Sub

Private Sub btnRestore_Click()
    Dim i As Long, n As Long

    n = ranges.Count
    For i = 1 To n
        ranges(i).Value = valCopies(i)
    Next i
End Sub

Private Sub btnSelect_Click()
    Dim choice As Range, A As Range
    Dim home As Worksheet, ws As Worksheet

    Set valCopies = New Collection
    Set ranges = New Collection
    Set home = ActiveSheet
    For Each ws In Sheets
        ws.Select
        Set choice = Nothing
        On Error Resume Next 'when the user hits cancel
        Set choice = Application.InputBox("Select cells from " & ws.Name, "Change/Restore", Selection.Address, , , , , 8)
        On Error GoTo 0
        If Not choice Is Nothing Then
            choice.Select 'for future reference
            For Each A In choice.Areas
                ranges.Add A
                valCopies.Add A.Value
            Next A
        End If
    Next ws
    home.Select
End Sub    

很容易修改，以便选择范围 sub 仅迭代预定的工作表集合。如果我了解您要执行的操作，如果您想确保在用户运行选择时保存原始(而不是修改后的)值，您可能希望在选择范围子的开头运行恢复子子不止一次。该代码尚未经过彻底测试，但似乎可以工作。一个警告——如果用户在选择时做了奇怪的事情，区域可能会重叠。上面的代码将修改任何此类重叠中包含的任何单元格 2(或更多)次。为了真正安全起见，您可能需要修改选择代码以确保区域不重叠。一种方法是通过 Chip Pearson 出色的 ProperUnion 函数运行这些区域: http://www.cpearson.com/Excel/BetterUnion.aspx