Как найти соответствующие заголовки на листе с помощью VBA?

Question

Есть лист с заголовками. Из этих заголовков я должен проверить / проверить, что доступны 12 заголовков. Если они доступны, сообщение должно отображаться как успешное, а если нет, то оно должно показывать, что заголовок speci c отсутствует.

Я создал подпрограмму и взял массив с этими двенадцатью значениями, но как сопоставить?

Answer 1

Пожалуйста, проверьте следующий код. Вы создадите массив заголовков таким образом, чтобы он отражал вашу реальность:

Sub testCheckHeadersArray()
  Dim sh As Worksheet, arrH As Variant, El As Variant, C As Range
  Dim boolFound As Boolean, strNotFound As String, lastCol As Long
    arrH = Split("Header1,Header3,Header4,Header5,Header6,Header7,Header8,Header9,Header10", ",")
    Set sh = ActiveSheet 'please, use here your sheet to be checked
    lastCol = sh.Cells(1, Cells.Columns.Count).End(xlToLeft).column

    For Each El In arrH
        boolFound = False
        For Each C In sh.Range(sh.Cells(1, 1), sh.Cells(1, lastCol))
            If UCase(El) = UCase(C.value) Then
                boolFound = True: Exit For
            End If
        Next
        If Not boolFound Then strNotFound = strNotFound & El & vbCrLf
    Next
    If strNotFound <> "" Then
       MsgBox "The next headers have not been found:" & vbCrLf & strNotFound
    Else
        MsgBox "Everything OK"
    End If
End Sub

Если у вас есть лист с правильными заголовками, вы можете извлечь массив из него:

Set shH = Worksheets("HeaderModel")
arrH = shH.Range(Range("A1"), shH.Cells(1, shH.Cells(1, _
          Cells.Columns.Count).End(xlToLeft).column)).value

Answer 2

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

    Option Explicit

Sub TestHeaderPresence()

    Dim CheckHeaders As Variant
    Dim Headers As String

    ' list the required headers
    Headers = "Header1,Header3,Header4,Header5,Header6,Header7,Header8," & _
              "Header9,Header10,Header11,Header12"
    ' pass the list to the function
    CheckHeaders = HeadersArePresent(Headers)
    If CheckHeaders = True Then
        MsgBox "All headers are present.", vbInformation, "Caption check"
    Else
        MsgBox "At least caption """ & CheckHeaders & """" & " is missing.", _
                vbInformation, "Caption check"
    End If
End Sub

Function HeadersArePresent(Headers As String) As Variant

    Dim Fun As String                       ' function return
    Dim Captions() As String
    Dim HeaderRange As Range
    Dim HeaderArray As Variant
    Dim Tmp As Variant
    Dim i As Long

    With ActiveSheet                ' replace with "With Worksheets("[tab name]")"
        ' Available Captions start from column "C" in row "1"
        '   modify as appropriate
        Tmp = .Range(.Cells(1, "C"), .Cells(1, .Columns.Count).End(xlToLeft)).Value
    End With

    ReDim HeaderArray(1 To UBound(Tmp, 2))
    For i = 1 To UBound(Tmp, 2)
        HeaderArray(i) = Tmp(1, i)
    Next i
    HeaderArray = Join(HeaderArray, ",")
    Captions = Split(Headers, ",")

    For i = 0 To UBound(Captions)
        If InStr(HeaderArray, Captions(i)) = 0 Then
            Fun = Captions(i)
            Exit For
        End If
    Next i

    ' return True or the name of first missing header
    HeadersArePresent = IIf(Len(Fun), Fun, True)
End Function

Answer 3

Подход с помощью функции Filter()

После определения набора обычных заголовков (~> [0]) и текущих заголовков (~> [1]), функция Filter() позволяет уменьшить первоначально полный набор заголовков, а затем перейти к следующему текущему заголовку с помощью 3-го аргумента включения, установленного на False (~> section [2]).

См. Справка MS : Если параметр include равен False, фильтр возвращает подмножество массива, не содержащего совпадения, в качестве подстроки

Sub ListMissingHeaders()
    '[0] define needed headers and assign them to 1-dim array
    Const HEADERLIST = "Header1,Header3,Header4,Header5,Header6,Header7,Header8,Header9,Header10"
    Dim regularHeaders: regularHeaders = Split(HEADERLIST, ",")
    '[1] get current headers
    With Sheet1                         ' << change to actual sheet's Code(Name)
        Dim lastCol As Long             ' get last column in head line
        lastCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

        Dim currHeaders                 ' assign current headers to 2-dim array
        currHeaders = .Range("1:1").Resize(columnsize:=lastCol)
    End With

    '[2] Filter regular set of headers passed to array missingHeaders
    Dim i As Long, missingHeaders
    missingHeaders = regularHeaders        ' start with complete set of headers
    For i = 1 To UBound(currHeaders, 2)    ' filter out existing headers one by one
        missingHeaders = Filter(missingHeaders, currHeaders(1, i), False, vbTextCompare)
    Next i

    '[3] show missing headers
    Debug.Print UBound(missingHeaders) + 1 & " missing Headers: """ & _
                Join(missingHeaders, """, """)
End Sub