用户窗体列表框以选择命名范围

Question

我在工作表上有一组命名范围，其中包含来自其他选项卡的摘要数据（每个月一个）。这些范围被命名为JAN / FEB / MAR 等。我的文件包含各种报告，这些报告将一个月与另一个月进行比较，为了使这种动态我需要用户能够比较任何两个月。

报告运行在一个单独的工作表上，该工作表有一个粘贴（值）版本的您需要的每月摘要数据，所以基本上我想要一个带有用户表单的宏，它允许用户选择一个月，然后它会发现范围，将其复制并粘贴到驱动报告的工作表中。我已经设法根据工作表名称做了类似的事情（见下面的代码），但我无法为命名范围做任何事情。

任何帮助都非常感谢，在这方面我是一个自学成才的业余爱好者。

Private Sub CommandButton1_Click()
    Dim i As Integer, sht As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sht = ListBox1.List(i)
        End If
    Next i
    Sheets(sht).Range("A4:C15").Copy
    Sheets("Sheet1").Select.Range("N1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    End
End Sub

Private Sub CommandButton2_Click()
    Unload UserForm2
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ListBox1.AddItem (ws.Name)
    Next ws
End Sub

Answer 1

首先，您需要一个允许用户选择月份的 UI 控件，可能是一个 ComboBox。然后，根据所选值，您可以选择要选择的命名范围。您选择该范围并使用简单的 for-each 循环对其进行迭代。

最后，它可能看起来像这样：

Sub Main(selectedMonth as Integer)
    Dim referenceName As String
    Dim monthRange As Range
    Dim cell As Range

    Select Case selectedMonth
        Case 1
            referenceName = "JanuaryRange"
        Case 2
            referenceName = "FebruaryRange"
        ' etc
    End Select

    If referenceName <> "" Then
        Set monthRange = Range(referenceName)

        For Each cell In monthRange
            ' Add cell.Value as item to your listbox
        Next cell
    End If
End sub

您可能需要添加更多错误处理。

PS：你真的应该为你的对象使用描述性的名称，如果你有两个，CommandButton2 可能没问题，一旦你有更多，你会过得很糟糕。

Answer 2

您可以在组合框中加载所有月份名称：

Private Sub Userform_Initialize()
 combobox1.List = Application.GetCustomListContents(4)
end sub

您可以复制选定的月份范围：

Private Sub Combobox1_Change()
 With ThisWorkbook.Names(combobox1.value)
  sheets("sheet1").cells(1,14).Resize(.RefersToRange.Rows.Count, .RefersToRange.Columns.Count) = .RefersToRange.Value
 End With
End Sub

Answer 3

感谢您的快速回复（以及描述性名称 Marek 的好建议）

组合框很好用，但我也设法让我的原始列表框按如下方式工作（不确定这是技术上最合理的方式，但似乎工作正常）...

我确实必须激活工作表才能粘贴，我知道这不是最佳做法，但没有写下来会很不开心，所以我妥协并让它随心所欲！

变暗为整数

私有子命令按钮3_Click() 卸载 UserForm1 结束子

私有子ListBox1_Click()

结束子

私有子命令按钮1_Click() Dim i As Integer, rng As String 对于 i = 0 到 ListBox1.ListCount - 1 如果 ListBox1.Selected(i) = True 那么 rng = ListBox1.List(i) 万一 接下来我 范围(rng).复制 表格（“驱动器”）。激活 Range("A5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=假，转置：=假 Application.CutCopyMode = False 表格（“报告”）。激活 结束

结束子

私有子 UserForm_Initialize()

使用 ListBox1

.AddItem "JAN"
.AddItem "FEB"
.AddItem "MAR"
.AddItem "APR"
.AddItem "MAY"
.AddItem "JUN"
.AddItem "JUL"
.AddItem "AUG"
.AddItem "SEP"
.AddItem "OCT"
.AddItem "NOV"
.AddItem "DEC"

结束

结束子

私有子 CommandButton2_Click()

Dim i As Integer, rng As String
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        rng = ListBox1.List(i)
    End If
Next i
Range(rng).Copy
Sheets("DRIVE").Activate
Range("A43").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("REPORTS").Activate
End

结束子