Список проверки ячейки с отфильтрованными значениями заголовка таблицы

Question

Я хочу включить проверку данных для столбца на основе заголовков именованной таблицы. Пользователи будут добавлять дополнительные столбцы с названием страны в качестве заголовков. Я попытался выполнить проверку данных ячейки для именованного диапазона, значение именованного диапазона =TripCost[#Headers] 'TripCost is the the name of the table. Но я понимаю все ценности. Я хочу игнорировать любое значение, начинающееся с «Замечания» или «Стоимость». Есть ли способ добиться этого?

Answer 1

Попробуйте,

Sub test()
    Dim Ws As Worksheet
    Dim objList As ListObject
    Dim vR(), vDB
    Dim sFormula As String
    Dim Target As Range
    Dim j As Integer
    
    Set Ws = ActiveSheet
    Set objList = Ws.ListObjects("TripCost")
    
    vDB = objList.HeaderRowRange
    For j = 2 To UBound(vDB, 2) Step 2
        n = n + 1
        ReDim Preserve vR(1 To n)
        vR(n) = vDB(1, j)
    Next j
    sFormula = Join(vR, ",")
    
    Set Target = ActiveCell
    
    With Target.Validation
        .Delete
        .Add xlValidateList, xlValidAlertStop, xlBetween, sFormula
    End With
    
    
End Sub

Answer 2

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

Private Sub selectiveNameValidation()
 Dim sh As Worksheet, rng As Range, arrH As Variant, El As Variant, strList As String

 Set sh = ActiveSheet

  Set rng = ActiveCell 'use here what range you need
  
  'arrH = Range("Headers").Value 'use here a named range for the headers in discussion ("Headers")
  'or use your Table headers:
  arrH = sh.ListObjects("TripCost").HeaderRowRange.Value' load the range in an array
  For Each El In arrH
    If Not (InStr(El, "Cost") > 0 Or InStr(El, "Remark") > 0) Then
         strList = strList & IIf(strList = "", "", ",") & El 'build the list string
    End If
  Next

  With rng.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                                xlBetween, Formula1:=strList
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
  End With
End Sub

Если появятся другие исключаемые строки, вы должны только расширить строку

If Not (InStr(El, "Cost") > 0 Or InStr(El, "Remark") > 0) Then

с новым:

If Not (InStr(El, "Cost") > 0 Or InStr(El, "Remark") > 0 Or InStr(El, "NewOne") > 0 ) Then