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    

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