比较两列，其中一列不是必需的

我建议您将代码重构为 3 个部分。1-阅读设置，2-分析工作表，然后3-检查数据。依次调试每个步骤。

Function Main_Check2(ByVal StrFilePath As String) As String

    Const CHECK = "Check_file"
    
    Dim wb As Workbook, ws As Worksheet, arHdr
    Dim booCheck As Boolean, bExists As Boolean
    Dim iColFee As Long, i As Long, msg As String
    
     ' check valid filepath
    If Dir(StrFilePath) = "" Then
        msg = "'" & StrFilePath & "' does not exist"
        MsgBox msg, vbCritical, "File not found"
        Main_Check2 = msg
        Exit Function
    End If
    
     ' open file and check sheet exists
    Set wb = Workbooks.Open(StrFilePath)
    bExists = False
    For Each ws In wb.Sheets
        If ws.Name = CHECK Then
            bExists = True
            Exit For
        End If
    Next
    
    If Not bExists Then
        msg = "Sheet '" & CHECK & "' not found in " & wb.FullName
        MsgBox msg, vbCritical, "Sheet not found"
        wb.Close False
        Exit Function
    End If
    
    ' get header details from settings sheet
    Call GetSettings(Settings, arHdr)
    
    ' check headers, find fee column
    booCheck = CheckHeaders(ws, arHdr, iColFee)
    'Call DumpArray(arHdr) ' check results so far
    
    ' exit if false
    If booCheck = False Then
         Main_Check2 = booCheck
         Exit Function
    End If
    
    ' check data
    With ws
                
        '//All line items are run through and the individual criteria are checked
        Dim rngData As Range, sName As String, n As Long
        Dim iRow As Long, iCol As Long, lastrow As Long, cell As Range
        
        For i = 1 To UBound(arHdr)
        
            sName = arHdr(i, 1) ' header name
            iCol = arHdr(i, 4) ' header column
            iRow = arHdr(i, 5) ' header row
            n = arHdr(i, 6) ' number of rows
            
            ' scan column
            If iCol > 0 And n > 0 Then
                Set rngData = .Cells(iRow + 1, iCol).Resize(n)
                Select Case sName
                    Case "Company"
                        For Each cell In rngData
                            If cell.Value Like "####" Then
                               cell.Interior.Pattern = xlNone
                            Else
                               cell.Interior.Color = vbRed
                               booCheck = False
                            End If
                        Next
                    
                    Case "Fee"
                        For Each cell In rngData
                            If Not cell.Value Like "*,*" Then
                               cell.Interior.Pattern = xlNone
                            Else
                               cell.Interior.Color = vbRed
                               booCheck = False
                            End If
                        Next
                                    
                    Case "Gross Fee"
                        ' optional - skipped if icol = 0
                        For Each cell In rngData
                            If Len(cell) = 0 Then
                                cell.Interior.Pattern = xlNone
                            ElseIf cell.Value <> .Cells(cell.Row, iColFee).Value Then
                                cell.Interior.Color = vbRed
                                booCheck = False
                            Else
                                cell.Interior.Pattern = xlNone
                            End If
                        Next
                End Select
            End If
        Next
    End With
    
'//Define results
Ende:
    If booCheck = False Then
        ws.Cells(7, 7).Value = "Error counter:"
        ws.Cells(7, 8).Value = ws.Cells(7, 8).Value + 1
    Else
        ws.Cells(7, 7).Value = "Check ok"""
        ws.Cells(7, 8).Value = ""
    End If

    'wb.Close True
    Main_Check2 = booCheck '& "," & Replace(CStr(rngFind.Address), "$", "")

End Function

Function GetSettings(ws, ByRef arHdr) As Boolean

    Dim r1 As Long, r2 As Long, r3 As Long, r4 As Long
    Dim n As Long, m As Long, i As Long, msg As String
    
    With ws
        r1 = .Range("Header_Start").Row
        r2 = .Range("Header_Ende").Row
        r3 = .Range("NotMand_Start").Row
        r4 = .Range("NotMand_Ende").Row
       
        m = r2 - r1 - 1 ' mandatory header
        n = r4 - r3 - 1 ' non-mandatory headers
       
        If m < 1 Then
            msg = "No mandatory headers on setting"
            MsgBox msg, vbExclamation, "Settings Error"
            getSettings = False
        End If
       
        ' size array and fill
        ReDim arHdr(1 To n + m, 1 To 6)
        For i = 1 To m
            arHdr(i, 1) = .Cells(r1 + i, 1)
            arHdr(i, 2) = .Cells(r1 + i, 2) ' search term
            If Len(arHdr(i, 2)) > 0 Then ' skip blanks
                arHdr(i, 3) = True ' mandatory
            Else
                arHdr(i, 3) = False
            End If
        Next
        For i = 1 To n
            arHdr(m + i, 1) = .Cells(r3 + i, 1)
            arHdr(m + i, 2) = .Cells(r3 + i, 2)
            arHdr(m + i, 3) = False ' optional
        Next
                
    End With
    getSettings = True

End Function

Function CheckHeaders(ws, ByRef arHdr, ByRef iColFee) As Boolean

    '//Header Check
    'Checks all headers in advance to see if they are present
    'and writes the missing ones in a cell
    Dim rngTable As Range, rng As Range
    Dim msg As String, sHdr As String, sTableStart As String
    Dim i As Long, lastrow As Long, rowHdr As Long
    Dim booCheck As Boolean
   
    ' search value for column 1 of table
    sTableStart = arHdr(1, 2)
    With ws
         '//Find the beginning of the table
        Set rngTable = .Cells.Find(what:=sTableStart, LookIn:=xlValues, lookat:=xlWhole)
        If rngTable Is Nothing Then
            msg = "Could not find begining of table '" & sTableStart & "'"
            MsgBox msg, vbExclamation, "Error"
            CheckHeaders = False
            Exit Function
        Else
            rowHdr = rngTable.Row
        End If
    
        For i = 1 To UBound(arHdr)
            sHdr = Trim(arHdr(i, 2))
            If Len(sHdr) > 0 Then ' skip blanks
                Set rng = .Rows(rowHdr).Find(what:=sHdr, LookIn:=xlValues, lookat:=xlWhole)
                If rng Is Nothing Then
                    arHdr(i, 4) = 0
                Else
                    ' store fee column for later gross fee check
                    If arHdr(i, 1) = "Fee" Then iColFee = rng.Column
                    arHdr(i, 4) = rng.Column
                    arHdr(i, 5) = rng.Row
                    lastrow = .Cells(.Rows.Count, rng.Column).End(xlUp).Row
                    arHdr(i, 6) = lastrow - rng.Row - 1 ' data rows
                End If
            Else
                arHdr(i, 4) = 0
            End If
        Next
        
        ' check for mandatory column errors
        Dim sep As String
        For i = 1 To UBound(arHdr)
            If arHdr(i, 3) And arHdr(i, 4) = 0 Then
                msg = msg & sep & arHdr(i, 2)
                sep = ","
            End If
        Next

        If Len(msg) > 0 Then
            .Cells(4, 7) = "The following column labels were not found: "
            .Cells(4, 8) = msg
            .Cells(4, 8).Interior.Color = vbRed
            CheckHeaders = False
            'GoTo Ende
        Else
            .Cells(4, 7).Clear ' G4
            .Cells(4, 8).Clear ' H4
            CheckHeaders = True
        End If
    End With

End Function

' dump array to new workbook to  debug
Sub DumpArray(ar)
    Dim wb As Workbook: Set wb = Workbooks.Add
    With wb.Sheets(1)
       .Name = "arHdr"
       .Range("A1:F1") = Array("Header1", "Header2", "Mandatory", "Column", "Row", "DataRows")
       .Range("A2").Resize(UBound(ar), UBound(ar, 2)) = ar
    End With
    ' save - replace existing
    Application.DisplayAlerts = False
    wb.SaveAs "debug_arHdr.xlsx"
    Application.DisplayAlerts = True
    'wb.Close
End Sub