Question

工作表上有两个（ActiveX）列表框（Monthlist＆amp; Yearlist）。每个都填充了H（月）和I（年）列的唯一值（参见下面的代码）。用户将选择Monthlist中可用的月份。我希望“年份列表”中的可用项目反映“月份列表”中的选项。例如，如果2016年5月和2016年6月的工作表上有数据，并且用户从月份列表中选择“月”，则“2015”应仅在“年份列表”中可供选择。（'2016'应该变灰或不存在。）

显而易见的解决方案是将过滤器应用于H列，以反映Monthlist中的选择，然后将第I列中的唯一可见值收集到数组中并在Yearlist中显示它们。也许这个问题有更优雅的解决方案？谢谢你的帮助。

    Sub UniqueMonthsAndYears(ByVal ws As Object)

    Dim LastRow, i, j, k As Long
    Dim c As Range
    Dim MyArUniqVal() As Variant

    Dim i2, j2, k2 As Long
    Dim c2 As Range
    Dim MyArUniqVal2() As Variant

    Dim MonthList As MSForms.ListBox
    Dim YearList As MSForms.ListBox

    ReDim MyArUniqVal(0)
    ReDim MyArUniqVal2(0)


    Dim rng As Range
    Dim cl As Range


        LastRow = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row

         Set rng = Range("H9:H" & LastRow)

    With ThisWorkbook.ActiveSheet

        For Each cl In rng
            If cl.EntireRow.Hidden = False Then '//Use Hidden property to check if filtered or not
                  Debug.Print cl
                If cl.Value <> cl.Offset(1, 0).Value Then '~~~~~MonthArray

                    MyArUniqVal(UBound(MyArUniqVal)) = cl.Value
                    ReDim Preserve MyArUniqVal(UBound(MyArUniqVal) + 1)
                End If

                If cl.Offset(0, 1).Value <> cl.Offset(1, 1).Value Then 'Year Array
                    MyArUniqVal2(UBound(MyArUniqVal2)) = cl.Offset(0, 1).Value
                    ReDim Preserve MyArUniqVal2(UBound(MyArUniqVal2) + 1)
                End If

           End If
        Next cl

        ReDim Preserve MyArUniqVal(UBound(MyArUniqVal) - 1)
        ReDim Preserve MyArUniqVal2(UBound(MyArUniqVal2) - 1)

    End With

'Fill the listbox
 ws.YearList.Clear

For k2 = 0 To UBound(MyArUniqVal2)

    ws.YearList.AddItem (MyArUniqVal2(k2))

Next k2

ws.MonthList.Clear

For k = 0 To UBound(MyArUniqVal)

    ws.MonthList.AddItem (MyArUniqVal(k))

Next k

End Sub

列表框项目选择基于其他列表框项目选择

0 个答案: