Цитирование через несколько именованных диапазонов и переход к аналогичному диапазону имен VBA

Question

Я хотел бы проверить несколько именованных диапазонов для значения boolean True/False. Мне нужно проверить диапазоны проверки 1-ячеек (в порядке), и если результат True, мне нужно указать .Select соответствующий именованный диапазон (т. Е. Именованный диапазон без соответствующего префикса "validation_" и выйти из подпрограммы. работает, но это не DRY

Вот отрывок, чтобы получить суть вопроса, но это If-ElseIf продолжается на протяжении многих других названных диапазонов:.

If Range("validation_name") = True Then 
    Range("name").Select 
    Exit Sub 
ElseIf Range("validation_category") = True Then 
    Range("category").Select 
    Exit Sub 
ElseIf Range("validation_subcategory") = True Then 
    Range("subcategory").Select 
    Exit Sub 
' ... and many more... 

Возможности/Вопросы:

• Я думаю, что я мог бы использовать либо массив именованных диапазонов, и массив получаемых «go-to» названных диапазонов?
• Возможно, я мог бы использовать collection вместо этого?
• Не уверен, что цикл for или цикл while будет лучше?

Answer 1

некоторые «лишних» сухих код

Sub main() 
    Dim a As Variant 
    For Each a In Array("name", "category", "subcategory") 
     If Range("valid_" & a).Value = True Then 
      Range(a).Select 
      Exit Sub 
     End If 
    Next a 
End Sub 

Sub main2() 
    Dim r As Range, f As Range   
    Set r = Union(Range("validation_date"), Range("validation_name"), Range("validation_subcategory"), Range("validation_category")) 
    Set f = r.Find(what:="true", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) 
    If Not f Is Nothing Then Range(Replace(f.name.name, "validation_", "")).Select 
End Sub 

Answer 2

Я предполагаю, что это диапазоны с 1 ячейкой. Если это так, то следующее должно работать:

Sub SelectRange() 
    Dim i As long, A As Variant 
    A = Array("validation_name", "validation_category", "validation_subcategory") 
    For i = 0 To UBound(A) 
     If Range(A(i)).Value = True Then 
      Range(Split(A(i),"_")(1)).Select 
      Exit Sub 
     End If 
    Next i 
End Sub 

Answer 3

Вы можете перебрать все из названных диапазонов с чем-то вроде:

Dim xlName As Name 
For each xlName In ActiveWorkbook.Names 
    If xlName.Name Like "validation_*" And Range(xlName.Name) = True Then 
     Application.Goto Replace(xlName.Name, "validation_", ""), True 
     Exit Sub 
    End If 
Next 

или указать их как этот

For each strName In Split("name category subcategory") 
    If Range("validation_" & strName) = True Then 
     Application.Goto strName, True 
     Exit Sub 
    End If 
Next 

Update

Извините, я не прочитал весь вопрос. Похоже, вы можете использовать какое-то ключ - значение коллекции

pairs = Array(Array("validation_name", "name"), _ 
       Array("validation_category", "category"), _ 
       Array("validation_subcategory", "subcategory")) 

For each pair In pairs 
    If Range(pair(0)) = True Then 
     Application.Goto pair(1), True 
     Exit Sub 
    End If 
Next