Excel VBA: поиск номера столбца N-го имени поля

Question

У меня есть функция, в которой я указываю нужное поле и номер строки заголовка, и он возвращает столбец.Например, =findField("Region",1) вернул бы номер столбца, содержащий заголовок "Регион".Это работало хорошо, пока я не столкнулся с отчетом, содержащим повторяющиеся имена в строке заголовка.Например, вместо 1-го и фамилии в обоих полях будет указано «Имя», поэтому мне нужно было указать вхождение, которое я хотел, как в =findField("Name",1,2) для 2-го вхождения.Я придумал решение, но у него есть 2 проблемы.Во-первых, если поле находится в первом столбце, оно не будет работать должным образом.Например, если столбцы A и B имеют «Имя», то =findField("Name",1,1) вернет второе поле вместо первого, а =findField("Name",1,2) обернет и вернет 1-е, что не то, что я хочу.Вторая проблема заключается в том, что она оборачивается вокруг, что я бы предпочел, чтобы она вообще не делала.Я придумал следующее:

Function findField2(fieldName As String, Optional rowStart As Long = 0, Optional occurrence As Long = 1)
    Dim Found As Range, lastRow As Long, count As Integer, myCol As Long

    If rowStart = 0 Then rowStart = getHeaderRow()
    myCol = 1

    For count = 1 To occurrence
        Set Found = Rows(rowStart).Find(what:=fieldName, LookIn:=xlValues, lookat:=xlWhole, After:=Cells(rowStart, myCol))

        If Found Is Nothing Then
            MsgBox "Error: Can't find '" & fieldName & "' in row " & rowStart
            Exit Function
        Else
            myCol = Found.Column
        End If
    Next count

    lastRow = Cells(Rows.count, Found.Column).End(xlUp).Row
    findField2 = Found.Column

Что мне нужно сделать, чтобы поле было в столбце A?Установка 0 для myCol не работает.Первоначальная функция поиска была основана на https://www.mrexcel.com/forum/excel-questions/629346-vba-finding-text-row-1-return-column.html, и я настраивал ее в соответствии со своими потребностями.

Спасибо, Бен

Answer 1

Эта версия использует FindNext для поиска вхождений после первого.
Поиск в Sheet1 рабочей книги, в которой находится код (ThisWorkbook):

Sub Test()

    Dim MyCell As Range

    'Second occurrence default row.
    Set MyCell = FindField("Date", Occurrence:=3)

    If Not MyCell Is Nothing Then
        MsgBox "Found in cell " & MyCell.Address & "." & vbCr & _
            "Row: " & MyCell.Row & vbCr & "Column: " & MyCell.Column & vbCr & _
            "Sheet: '" & MyCell.Parent.Name & "'" & vbCr & _
            "Workbook: '" & MyCell.Parent.Parent.Name & "'", vbOKOnly + vbInformation
    Else
        MsgBox "Value not found."
    End If

End Sub

Public Function FindField(FieldName As String, Optional RowStart As Long = 0, _
    Optional Occurrence As Long = 1) As Range

    Dim rFound As Range
    Dim x As Long
    Dim sFirstAdd As String

    If RowStart = 0 Then RowStart = 1
    x = 1

    With ThisWorkbook.Worksheets("Sheet1").Rows(RowStart)
        Set rFound = .Find( _
            What:=FieldName, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            After:=.Cells(RowStart, .Columns.Count))

        If Not rFound Is Nothing Then
            Set FindField = rFound
            If Occurrence <> 1 Then
                sFirstAdd = rFound.Address
                Do
                    Set rFound = .FindNext(rFound)
                    x = x + 1

                Loop While x <> Occurrence And rFound.Address <> sFirstAdd
                If rFound.Address = sFirstAdd Then
                    Set FindField = Nothing
                End If
            End If
        End If
    End With

End Function

Answer 2

Найдено в строке Column feat.The Wrap Around Issue

Здесь нет ссылок на объекты, т. е. все относится к ActiveSheet (из ActiveWorkbook).

Find (After)

By по умолчанию метод Find начинает поиск со следующей ячейки (6. SearchDirection xlNext или 1) предоставленного параметра диапазона ячеек аргумента After (2. После ), т.е. если вы используете ячейку A1 по строке (5. SearchOrder xlByRows или 1), поиск начнется с B1, продолжайте допоследний столбец, оберните его и продолжайте с A1 last.Следовательно, последняя ячейка строки должна использоваться для начала поиска с первой ячейкой A1.

Обтекание

. Обтекание Проблема решается с помощью оператора If, только если номер вхождения больше 1. Если вхождение не найдено, возвращается 0.
Номер столбца найденной ячейки (intCol) передается переменной (intWrap), и при каждом следующем вхождении значения они сверяются друг с другом.Теперь, если переменная равна номеру столбца, функция возвращает -1, указывая, что значение было найдено, но указанное вхождение не было найдено.

'*******************************************************************************
' Purpose:    Finds the Nth occurrence of a value in cells of a row            * 
'             to return the column number of the cell where it was found.      *
'*******************************************************************************
' Inputs                                                                       *
'   FindValue:          The value to search for.                               *
'   FindRow:            The row to search in.                                  *
'   OccurrenceNumber:   The occurrence number of the value to search for.      *
'*******************************************************************************
' Returns:    The column number of the Nth occurrence of the value.           *
'              0 if value was not found.                                       *
'             -1 if value was found, but not the specified occurrence of it.   *
'             -2 if worksheet has no values (-4163).                           *
'             -3 if workbook is add-in (No ActiveSheet).                       *
'*******************************************************************************
Function FoundinrowColumn(FindValue As Variant, Optional FindRow As Long = 0, _
    Optional OccurrenceNumber As Integer = 1) As Integer

  Dim intCol As Integer     ' Search Start Column Number
  Dim intCount As Integer   ' OccurrenceNumber Counter
  Dim intWrap As Integer    ' Wrap Around Stopper

  ' Check if ActiveSheet exists.
  If ActiveSheet Is Nothing Then FoundinrowColumn = -3: Exit Function
  ' Check if sheet has no values.
  If Cells.Find("*", Cells(Rows.count, Columns.count), -4163, 1, 1) _
      Is Nothing Then FoundinrowColumn = -2: Exit Function

  ' Find first used row if no FindRow parameter.
  If FindRow = 0 Then
    FindRow = Cells.Find("*", Cells(Rows.count, Columns.count)).Row
  End If
  ' Set initial Search Start Column Number.
  intCol = Columns.count

  ' Try to find the Nth occurence of 'FindValue' in 'FindRow'.
  For intCount = 1 To OccurrenceNumber
    If Not Rows(FindRow).Find(FindValue, Cells(FindRow, intCol)) Is Nothing Then
      intCol = Rows(FindRow).Find(FindValue, Cells(FindRow, intCol)).Column
      If intCount > 1 Then
        If intCol = intWrap Then FoundinrowColumn = -1: Exit Function
       Else
        intWrap = intCol
      End If
     Else
      FoundinrowColumn = 0: Exit Function
    End If
  Next

  FoundinrowColumn = intCol

End Function
'*******************************************************************************

Answer 3

Спасибо за ваши ответы.Я подбираю полезные методы, которые очень помогают.Я на самом деле исправил первую проблему, основанную на @TimWilliams, чтобы установить myCol в последний столбец, чтобы он начинал поиск в первом столбце, и добавил проверку на обертывание, как показано ниже.Я также изменил msgBox, чтобы он возвращал значение вместо @ VBasic2008.

Function findField2(fieldName As String, Optional rowStart As Long = 0, Optional occurrence As Long = 1)
    Dim Found As Range, lastRow As Long, count As Integer, myCol As Long

    If rowStart = 0 Then rowStart = getHeaderRow()
    myCol = 16384

    For count = 1 To occurrence
        Set Found = Rows(rowStart).Find(what:=fieldName, LookIn:=xlValues, lookat:=xlWhole, After:=Cells(rowStart, myCol))

        ' Check if nothing found or for wrap around and Nth occurrence not found
        If Found Is Nothing Or count > 1 And Found.Column <= myCol Then
            findField2 = 0
            Exit Function
        Else
            myCol = Found.Column
        End If
    Next count


    lastRow = Cells(Rows.count, Found.Column).End(xlUp).Row
    findField2 = Found.Column
End Function

Вот функция getHeaderRow, упомянутая выше в функции findField:

Function getHeaderRow() As Long
    Dim i As Long, lastCol As Long, lastRow As Long
    lastCol = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
    lastRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
    i = 1

    Do While Cells(i, lastCol).Value = ""
        i = i + 1
        If i > lastRow Then
            i = 0
            Exit Do
        End If
    Loop

    getHeaderRow = i
End Function

Answer 4

Вот что-то, не использующее Find(), которое все равно должно соответствовать вашим целям:

Function findField2(fieldName As String, Optional rowStart As Long = 0, _
                                           Optional occurrence As Long = 1)
    Dim a, rw As Range, m

    If rowStart = 0 Then rowStart = getHeaderRow()

    With ActiveSheet 'might be better to pass the sheet as a parameter
        Set rw = Application.Intersect(.Rows(rowStart), .UsedRange)
        a = .Evaluate("=IF(" & rw.Address & "=""" & fieldName & _
                            """,COLUMN(" & rw.Address & "),FALSE)")
    End With

    m = Application.Small(a, occurrence) 'find the n'th match (will return an error if none)

    If IsError(m) Then MsgBox "No occurrence #" & occurrence & " of '" & _
                              fieldName & "' on row# " & rowStart, vbExclamation

    findField2 = IIf(IsError(m), 0, m)
End Function

Sub Tester()
    Debug.Print findField2("A", 5, 40)
End Sub