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

数据集：

实践中的“测试验证工作表”，再次只是一个演示：

Answer 2

编辑：您想将代码更改为xlDescending，但是同样的想法适用

在触发worksheet_change事件之前，我们看到范围未排序。在单元格D1中显示为选项的前十个项目是该范围中的前十个项目。

当我们更改范围为I1：I20的值时，我们触发worksheet_change事件。在此函数中，我们具有对范围H1：I20进行排序的代码。

这是worksheet_change函数的代码，它位于您要使用的工作表的工作表模块中的位置

最后，这是如何将数据验证限制与范围链接。更改范围H1：I10（又名前十）将更改框中可用的选项。

代码段

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rangeOfTable As Range
            Set rangeOfTable = ActiveSheet.Range("H1:I20")

        If Not Application.Intersect(Target, rangeOfTable) Is Nothing Then
            rangeOfTable.Sort Range("I1:I20"), xlAscending
        End If
End Sub

编辑：也可用于下拉框

编辑：这段代码将带给您想法RE如何对多个值进行排序

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rangeOfTable As Range
            Set rangeOfTable = ActiveSheet.Range("H1:J20")

        If Not Application.Intersect(Target, rangeOfTable) Is Nothing Then
            With rangeOfTable
                .Sort key1:=ActiveSheet.Range("I1:I20"), order1:=xlAscending, _
                    key2:=ActiveSheet.Range("J1:J20"), Order2:=xlAscending
            End With
        End If
End Sub

这是事件触发后的数据，请注意，列表中的前十名是下拉框中仅有的十个

Excel VBA动态数据验证下拉列表具有多个条件排名

2 个答案: