具有多个标准排名的 Excel VBA 动态数据验证下拉列表

Question

我正在尝试创建一个动态下拉数据验证列表，该列表将对工作表中的多个标准(#2 或更多)进行排名，我的列表中有 300 个项目，我想根据表格中另一个工作表中的信息对它们进行排名。

根据排名(1 到 300)，我希望下拉数据验证列表包含根据排名计算的前 10、前 25 和顶部/底部 # 值。我不介意帮助列。如果我排名的数据/表格发生变化，和/或如果我想添加一个标准，我希望前 10 名、前 25 名等进行相应的更改。

当我使用高级过滤器以及在这种情况下的前 25 个值时，我已经使用宏记录器进行了记录。

Sub Makro2()
Selection.AutoFilter
Range("T[#All]").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("A1:J3"), Unique:=False

Range("T[[#Headers],[2017]]").Select
ActiveSheet.ShowAllData

Selection.AutoFilter

ActiveSheet.ListObjects("T").Range.AutoFilter Field:=2, Criteria1:="25", _
    Operator:=xlTop10Items
End Sub

这在带有或不带有 VBA 的 Excel 2016 中是否可行？

编辑:我找到了这个帖子 Data Validation drop down list not auto-updating该线程中的这段代码可能是我正在寻找的。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' Ensure all lists are made from tables and that these tables are named
' in the Name Manager.
' When creating your Data Validation List, instead of selecting a range
' in 'Source', click within 'Source' and press 'F3'. Finally select your
' tables name.
Dim strValidationList As String
Dim strVal As String
Dim lngNum As Long

On Error GoTo Nevermind
strValidationList = Mid(Target.Validation.Formula1, 2)
strVal = Target.Value
lngNum = Application.WorksheetFunction.Match(strVal, ThisWorkbook.Names(strValidationList).RefersToRange, 0)

' Converts table contents into a formula
If strVal <> "" And lngNum > 0 Then
    Application.EnableEvents = False
    Target.Formula = "=INDEX(" & strValidationList & ", " & lngNum & ")"
End If

Nevermind:
    Application.EnableEvents = True

End Sub

更新:

我正在使用 LARGE 函数来获取 Table1 的前 15 个值。然后我使用 INDEX 和 MATCH 来查找前 15 个值的名称(第 2 列)。

然后，我使用 OFFSET 函数和 NAMED RANGE 来获取数据验证列表，当我将某些内容添加到列表底部时，该列表会自动更新。

现在我希望数据验证列表依赖于第一个下拉列表。我怎样才能做到这一点？

Answer 1

您正在正确地接近它，在加载列表之前对列表数据进行排序或过滤。我对您的问题感到困惑，但您似乎想知道在操作列表后如何创建数据验证下拉菜单？

这是一个示例，说明如何通过编写简单的测试代码来构建州列表，然后根据所选州构建县列表。也许这可以帮助您建立您的验证列表。

有两个工作表:

1) 一个用于数据列表项 ThisWorkbook.Worksheets("DataList")

2) 一个下拉菜单 ThisWorkbook.Worksheets("DD Report Testing")

在模块 Create_State_List

Option Explicit

'This is a two part validation, select a state and then select a county

Sub CreateStateList()
   Dim FirstDataRow As Double, LastDataRow As Double
   Dim StateCol As Double, CountyCol As Double
   Dim DataListSht As Worksheet
   Dim DDReportSht As Worksheet

   Dim StateListLoc As String
   Dim StateRange As Range

   Set DataListSht = ThisWorkbook.Worksheets("DataList")
   Set DDReportSht = ThisWorkbook.Worksheets("DD Report Testing")
   FirstDataRow = 3 'First row with a State
   StateCol = 2 'States are in Col 2 ("B")
   LastDataRow = DataListSht.Cells(DataListSht.Rows.Count, StateCol).End(xlUp).Row

   Set StateRange = DataListSht.Range(DataListSht.Cells(FirstDataRow, StateCol), DataListSht.Cells(LastDataRow, StateCol))

   StateListLoc = "D3" 'This is where the drop down is located / will be updated

   DDReportSht.Range(StateListLoc).ClearContents 'Clear the list as we build dynamically
   DDReportSht.Range(StateListLoc).Validation.Delete 'Clear the Validation

   'Create the State List
   With Range(StateListLoc).Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=DataList!" & StateRange.Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

End Sub

在模块 Create_County_List

Option Explicit

Private Sub CreateCountyList(StateChosen As String)

    Dim DataListSht As Worksheet
    Dim DDReportSht As Worksheet
    Dim StateRow As Double
    Dim NumStateCols As Double
    Dim StartStateCol As Double
    Dim i As Integer
    Dim LastDataRow As Double
    Dim CountyRange As Range
    Dim CountyListLoc As String

    Set DataListSht = ThisWorkbook.Worksheets("DataList")
    Set DDReportSht = ThisWorkbook.Worksheets("DD Report Testing")
    NumStateCols = 51 'We count the District of Columbia
    StateRow = DataListSht.Range("C2").Row
    StartStateCol = DataListSht.Range("C2").Column

    For i = 0 To NumStateCols 'Account for starting at zero rather than 1

        If CStr(Trim(DataListSht.Cells(StateRow, StartStateCol + i))) = StateChosen Then
            'find the last Data row in the column where the match is
            LastDataRow = DataListSht.Cells(DataListSht.Rows.Count, StartStateCol + i).End(xlUp).Row

            'Make the Dynamic list of Counties based on the state chosen
            Set CountyRange = DataListSht.Range(DataListSht.Cells(StateRow + 1, StartStateCol + i), DataListSht.Cells(LastDataRow, StartStateCol + i))

            CountyListLoc = "D4"

            DDReportSht.Range(CountyListLoc).ClearContents
            DDReportSht.Range(CountyListLoc).Validation.Delete

            'Create the County List
            With Range(CountyListLoc).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=DataList!" & CountyRange.Address
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With

           'Break loop
           i = 1000 ' should break loop off right here
        Else 'do not build a list
        End If
    Next i

End Sub

工作表包含单元格选择代码

Option Explicit

'This routine will react to changes to a cell in the worksheet
Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim DDReportSht As Worksheet
    Dim StateString As String
    Set DDReportSht = ThisWorkbook.Worksheets("DD Report Testing")

    Call CheckStatusBar 'Lets update the Status bar on selection changes

    'If the cell change is D3 on DD report (they want state so build list for state)
    If Not Intersect(Target, DDReportSht.Range("D3")) Is Nothing Then
            'Clear the county list until the state is chosen to avoid mismatch
            DDReportSht.Range("D4").ClearContents
            DDReportSht.Range("D4").Validation.Delete

            '*** Create the State Drop Down
            Call CreateStateList

    Else 'Do nothing
    End If


    'If the cell change is D4 on DD report (they want the county list so build it based on the state in D3)
    If Not Intersect(Target, DDReportSht.Range("D4")) Is Nothing Then
        'If there was a change to the state list go get the county list set up
        StateString = DDReportSht.Range("D3")
        Application.Run "Create_County_List.CreateCountyList", StateString
    Else 'Do nothing
    End If

    'If cell is D7 build a rig list
    If Not Intersect(Target, DDReportSht.Range("D7")) Is Nothing Then
        'Build the Rig List
        Call CreateRigList
    Else 'Do nothing
    End If

End Sub

数据集:


在实践中测试验证工作表，这只是一个演示: