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的良好建议）

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

我确实必须激活工作表以便粘贴我知道这不是最佳实践，但如果没有写入就不开心，所以我妥协了，让它顺其自然！

Dim rng As Integer

Private Sub CommandButton3_Click（）卸载UserForm1 结束子

私人子ListBox1_Click（）

End Sub

Private Sub CommandButton1_Click（） Dim i As Integer，rng As String 对于i = 0到ListBox1.ListCount - 1 如果ListBox1.Selected（i）= True则 rng = ListBox1.List（i）万一下一个我范围（RNG）.Copy 表（“驱动器”）。激活范围（“A5”）。PasteSpecial Paste：= xlPasteValues，Operation：= xlNone，SkipBlanks _ ：= False，Transpose：= False Application.CutCopyMode = False 表（“报告”）。激活端

End Sub

Private Sub 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"

结束

End Sub

Private Sub 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

End Sub

Userform Listbox用于选择命名范围

3 个答案: