修改一个用户窗体在多个工作表上工作

在过去的几周里，我花了大量的时间去做一些用户表单（不是我的优点之一）。 用我的预期用户表单，用户可以在电子表格上select他们想要的任何值（例如资产价格），然后应用微调器，这就模仿了这些资产的价格上涨/下降百分比，然后他们可以观察这会影响业务的各个方面。 然后他们有两个button，一个可以保持调整值，另一个重置值。

到目前为止，我有一个用户表单，似乎在各种工作表上工作，但选定的范围必须连续和一个，在这里有很大的帮助（见自己以前的问题），完美的作品非常连续的select，但他们必须相同的工作表。 不过，我希望能够在许多工作表上select许多不连续的范围，并且能够编辑这些范围。 我可靠地被告知，范围variables只能引用特定工作表上的范围，我认为这是我出错的地方。

代码为非连续范围的作品在下面，我真的不能获得这么远的功劳，因为我需要从这里得到很多的帮助，我还没有完全整理呢，任何人都可以build议我如何编辑或修改这个工作表，同时在多个工作表和不连续的范围内工作？

打开用户表单; 

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

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

在这里输入图像说明

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

 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

这将很容易修改，使select范围子只遍历预定的纸张集合。 如果我明白你想要做什么，你可能想要在select range的子开始处运行restore sub，如果你想确保在用户运行select时保存了原始值（而不是修改后的值）分不止一次。 代码没有被彻底testing，但似乎工作。 一个警告的话 – 如果用户在select时做了奇怪的事情，那么这个区域可以重叠。 上面的代码会修改任何这样的重叠2（或更多）次中包含的单元格。 为了确保安全，您可能需要修改select代码以确保区域不重叠。 一种方法是通过Chip Pearson出色的ProperUnionfunction来运行这些区域： http ://www.cpearson.com/Excel/BetterUnion.aspx

每个Excel Window跟踪选定的单元格，以便循环访问Windows集合： 

 Dim wdw As Window For Each wdw In Application.Windows Debug.Print wdw.Selection.Address(External:=True) Next wdw

但是，这种方法的问题是，您的代码需要确保用户只打开预期的工作簿或testing每个工作簿。 另外，如果用户在多个视图中有一个工作簿（“视图”选项卡上的“新build窗口”button），会发生什么情况？

Interesting Posts