VBA: Фильтрация списка и сохранение результата, как именованные диапазоны

Question

У меня есть следующий список:

Я хочу, чтобы сделать код VBA фильтрации различных имен, которые хранят они работают, и хранение привести к именованному диапазону с именем магазина, а диапазон - имена из списка, работающего в этом хранилище.

Например, названные диапазоны будут лондонскими ячейками B2 и B7 и т. Д.

EDIT:

Я знаю, что это неправильно, но я просто не могу решить эту проблему. VBA просто не то, что я хочу, чтобы он был в данный момент ... Сначала я создал новый столбец названных диапазонов, а затем продолжил.

Sub NamedRange() 

Dim arr() As Variant 

arr = Sheet1.Range("D2:D4").Value 

    Dim i As Integer 
    Dim j As Integer 
    Dim Name As String 
    Dim k1 As Range, k2 As Range 

    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    i = 0 

    Do While i < 4 
    Name = arr(i) 
    For j = 1 To Lastrow 
    k1 = Match(arr(i), Cells(i, 1).Value, 0) 
    k2 = Union(k1, k2) 

    Next j 

    Range(k2).Select 
    Application.Goto Reference:=arr(i) 

    Loop 


End Sub 

EDIT2: в течение двух часов, пытаясь понять функцию AdvancedFilter. Сделал его работу с использованием опции x1FilterCopy, но весь мой лист Excel будет бесполезным. Есть ли способ фильтрации и просто хранить отфильтрованный диапазон в переменной. Бог, VBA, почему вы так поступили?

Answer 1

Попробуйте это.

Обратите внимание, что, как указано выше, использование названных диапазонов таким образом, вероятно, не самый лучший подход.

Возможно, вам лучше объяснить вашу конечную цель (потому что вы можете отфильтровывать данные и манипулировать им оттуда).

Это, как говорится, делает то, что вы ищете.

Для каждой ячейки в B2:B10 мы увидим, существует ли именованный диапазон для этого значения.

Если именованный диапазон не существует, мы создаем его.

Если существует, мы объединяем два диапазона.

Затем мы можем щелкнуть по нашим отделам и выбрать диапазоны, захватив их значение.

Скопируйте и вставьте этот макрос и запустить NameTheRanges

Вы можете добавить код события листа один для выбора диапазонов при нажатии на кафедре.

Sub NameTheRanges() 

ClearAllNamedRanges 
Dim c As Range 
For Each c In Range("B2:B10") 
    If Not DoesNamedRangeExist(c.Value) Then 
     c.Offset(0, -1).Name = c.Value 
    Else 
     Union(Range(c.Value), c.Offset(0, -1)).Name = c.Value 
    End If 
Next c 

End Sub 

Function DoesNamedRangeExist(NR As String) As Boolean 
Dim checker As Range 
On Error Resume Next 
Set checker = Range(NR) 
On Error GoTo 0 
If checker Is Nothing Then 
    DoesNamedRangeExist = False 
Else 
    DoesNamedRangeExist = True 
End If 
End Function 

Sub ClearAllNamedRanges() 
Dim NR 
For Each NR In ActiveWorkbook.Names 
    NR.Delete 
Next 
End Sub 

Код события для выбора диапазона (Это идет в листе, который вы используете - Лист1 в моем случае):

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

If Target.CountLarge > 1 Then Exit Sub 
If Not Intersect(Target, Range("E2:E4")) Is Nothing Then Range(Target.Value).Select 

End Sub 

Результаты Когда я нажимаю Ливерпуль (In Cell E3).

Имя менеджера Результаты: