VBA для Excel - создать список проверки на основе данных из другого листа в той же книге

Question

У меня есть срочная потребность в VBA в Excel:

On sheet 1, i have

A         B                  C
-----------------------------------
        DATASET 1           variable1
                            variable2
                            variable3
        DATASET 2           variable4
                            variable5
                            variable6

        .......

на следующем листе (например, лист 2)

у меня есть

    D                   F
    -----------------------------------
    DATASET 1           variable1
                        variable2
                        variable3
                        ...
                        variable100
    DATASET 2           variable4
                        variable5
                        variable6
                        variable200

        .......

как мне написать макрос VBA для создания списка проверки для ввода данных листа 1. Когда я щелкаю ячейку, чтобы ввести переменную 1 для набора данных 1, она отображает список, извлеченный из листа 2, отфильтрованного по имени набора данных (например, набор данных 1)?

спасибо.

Answer 1

Предполагая, что показанный макет является точным и столбец A имеет пустые ячейки между каждой потенциальной группой именованных диапазонов, этот макрос создаст именованный диапазон из каждого значения столбца A, используя диапазон ячеек в столбце B:

Option Explicit

Sub AddNames()
Dim RNG As Range, LR As Long, Nm As Long

With ActiveSheet
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    Set RNG = Range("A:A").SpecialCells(xlConstants)

    For Nm = 1 To RNG.Areas.Count
        If Nm < RNG.Areas.Count Then
            ActiveWorkbook.Names.Add Name:=Replace(RNG.Areas(Nm).Cells(1).Value, " ", ""), _
                RefersToR1C1:="='" & .Name & "'!R" & RNG.Areas(Nm).Cells(1).Row & _
                    "C2:R" & RNG.Areas(Nm + 1).Cells(1).Row - 1 & "C2"
        Else
            ActiveWorkbook.Names.Add Name:=Replace(RNG.Areas(Nm).Cells(1).Value, " ", ""), _
                RefersToR1C1:="='" & .Name & "'!R" & RNG.Areas(Nm).Cells(1).Row & _
                    "C2:R" & LR & "C2"
        End If
    Next Nm
End With

End Sub