获取列表框的值以使用工作表动态更改

Question

当用户更改同一用户窗体中另一个列表框的值时，如何在userform中获取列表框的值以动态更改。给我带来麻烦的主要部分是lstMonth。 lstMonth的值应等于月份，这与将在第一个列表框中显示的不同工作表中的数据相关联。我将提供一份表格和数据的图片，以便这一切都可以提供更多信息。

代码

Option Explicit


Private Sub cmdCalc_Click()
    'declare variables and assign address to rngData variable
    Dim strId As String, intRow As Integer, intNumSales As Integer, curSales As Currency
    Dim rngData As Range
    Set rngData = Application.Workbooks("t13-ex-e4d.xls").Worksheets("jan").Range("a3").CurrentRegion
    'assign selected list box item to strId variable
    strId = lstId.Value
    'locate first occurrence of ID
    intRow = 2
    Do Until rngData.Cells(RowIndex:=intRow, columnindex:=4).Value = strId
        intRow = intRow + 1
    Loop
    'accumulate and count salesperson's sales, stop when loop encounters different ID
    Do While rngData.Cells(RowIndex:=intRow, columnindex:=4).Value = strId
        curSales = curSales + rngData.Cells(RowIndex:=intRow, columnindex:=3).Value
        intNumSales = intNumSales + 1
        intRow = intRow + 1
    Loop
    'display appropriate amount
    If optTotal.Value = True Then
        lblAnswer.Caption = Format(expression:=curSales, Format:="currency")
    Else
        lblAnswer.Caption = Format(expression:=curSales / intNumSales, Format:="currency")
    End If

End Sub

Private Sub cmdCancel_Click()
    'close custom dialog box
    Unload frmSalesCalc

End Sub


Private Sub UserForm_Initialize()

lstMonth.Value = Application.Workbooks("T13-EX-E4D.xls").ActiveSheet.Range("b3").CurrentRegion


End Sub

Answer 1

在表单上打开填写所有可用表单的月份列表框

     ' Declare Current as a worksheet object variable.
     Dim Current As Worksheet

     ' Loop through all of the worksheets in the active workbook.
     For Each Current In Worksheets

        ' Insert your code here.
        ListBox_Month.AddItem Current.Name
     Next

如果单击月份列表，其余的基本上是填充其他列表框，包含所有可用的ID。所以在Listbox_Change方法中你需要这样的东西：

Dim sales_ids as Variant 
sales_ids = UniquesFromRange(Worksheets(Listbox_Month.value).Range(D))

Function UniquesFromRange(rng As Range)
 Dim d As Object, c As Range, tmp
 Set d = CreateObject("scripting.dictionary")
 For Each c In rng.Cells
   tmp = Trim(c.Value)
   If Len(tmp) > 0 Then
        If Not d.Exists(tmp) Then d.Add tmp, 1
   End If
 Next c
 UniquesFromRange = d.keys
End Function

现在你已经拥有了所有的id，将它们填入第二个列表框，瞧，剩下的应该是明确的，但只是问你是否还有问题