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

Возможно ли это в Excel 2016 с VBA или без VBA?

Редактировать: Я нашел эту тему Раскрывающийся список Проверка данных не обновляется автоматически , и этот код в этой теме может быть тем, что я ищу.

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, чтобы получить 15 лучших значений таблицы Table1. Затем я использую INDEX и MATCH, чтобы найти имена 15 лучших значений (столбец 2).

Затем я использую функцию OFFSET и NAMED RANGE, чтобы получить список проверки данных, который автоматически обновляется, когда я добавляю что-то в конец списка.

Теперь я хочу, чтобы список проверки данных зависел от первого выпадающего списка. Как мне этого добиться?

Answer 1

РЕДАКТИРОВАТЬ: вы хотите изменить код на 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

РЕДАКТИРОВАТЬ: Работает с окнами dropDown

РЕДАКТИРОВАТЬ: этот код даст вам представление о том, как сортировать несколько значений

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

вот данные после того, как событие сработало, обратите внимание, что первая десятка в списке - единственная десятка в выпадающем списке

Answer 2

Вы подходите к нему правильно, сортируете или фильтруете данные своего списка перед загрузкой списка. Я запутался в вашем вопросе, но, похоже, вам интересно, как создать выпадающий список проверки данных после того, как вы манипулировали своим списком?

Вот пример того, как это делается с помощью простого тестового кода, написанного для построения списка состояний, а затем списка округов на основе выбранного состояния. Может быть, это поможет вам создать списки проверки.

Существует две таблицы:

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

DataSet:

Test Validation Worksheet на практике, опять же, это просто демонстрация: