Как зациклить таблицу и получить доступ к элементам строки по заголовку столбца?

Question

У меня есть следующий макрос, который должен пройти через таблицу Excel-2007. Таблица имеет несколько столбцов, и в настоящее время я нахожу правильную позицию столбца, используя столбцы свойств Index.

Использование индекса - единственный способ найти правильный индекс для объекта fName. Лучший вариант, на который я надеюсь, это получить доступ к определенным столбцам, используя имя столбца / заголовок. Как я могу это сделать, и это может быть даже сделано?

Кроме того, в общем, есть ли лучший способ построить этот цикл?

Worksheets("Lists").Select

Dim filesToImport As ListObject 
Dim fName As Object
Dim fileNameWithDate As String

Dim newFileColIndex As Integer
Dim newSheetColIndex As Integer
Set filesToImport = ActiveSheet.ListObjects("tblSourceFiles")

newFileColIndex = filesToImport.ListColumns("New File Name").Index // <- Can this be different?

For Each fName In filesToImport.ListRows // Is there a better way?
    If InStr(fName.Range(1, col), "DATE") <> 0 Then
        // Need to change the ffg line to access by column name
        fileNameWithDate = Replace(fName.Range(1, newFileColIndex).value, "DATE", _
                                  Format(ThisWorkbook.names("ValDate").RefersToRange, "yyyymmdd"))
        wbName = OpenCSVFIle(fPath & fileNameWithDate)
        CopyData sourceFile:=CStr(fileNameWithDate), destFile:=destFile, destSheet:="temp"
    End If

Next fName2

Answer 1

Предисловие

Я нашел это через Google, и мне не хватало.Итак, я собираюсь заполнить еще немного информации, объяснить, что происходит, а также немного оптимизировать код.

Объяснение

Очевидный ответ, который должен был быть представлен вам:1007 * Да, это можно сделать.На самом деле, это проще, чем вы думаете.

Я заметил, что вы сделали это

newFileColIndex = filesToImport.ListColumns("New File Name").Index

, который дал вам индекс заголовка "Новое имя файла".
Затем,когда вы решили проверить столбцы, вы забыли, что индекс на самом деле также является относительной позицией столбца.

Таким образом, вместо номера столбца вы должны были сделать то же самое, что и раньше

InStr(fName.Range(1, filesToImport.ListColumns("Column Name")), "DATE")

Давайте копнем немного глубже и объясним не только словами, но и картинками

На рисунке выше в первой строке показан абсолютный индекс столбца,
, где A1 имеетиндекс столбца 1, B1 имеет индекс столбца 2 и т. д.

Заголовки ListObject имеют свои собственные относительные индексы, где, в этом примере, Column1 будет иметь индекс столбца 1, Column2будет иметь индекс столбца 2 и так далее.Это позволяет нам использовать свойство ListRow.Range при обращении к столбцам с номерами или именами.

Чтобы лучше продемонстрировать, вот код, который печатает относительный и абсолютный индекс столбца "Column1""из предыдущего изображения.

Public Sub Example()
    Dim wsCurrent As Worksheet, _
        loTable1 As ListObject, _
        lcColumns As ListColumns

    Set wsCurrent = ActiveSheet
    Set loTable1 = wsCurrent.ListObjects("Table1")
    Set lcColumns = loTable1.ListColumns

    Debug.Print lcColumns("Column1").Index        'Relative. Prints 1
    Debug.Print lcColumns("Column1").Range.Column 'Absolute. Prints 3
End Sub

Поскольку ListRow.Range относится к диапазону, он становится вопросом относительности, поскольку этот диапазон находится внутри ListObject.

Так, например, чтобы ссылаться на Column2 в каждой итерации ListRow, вы можете сделать это следующим образом:

Public Sub Example()
    Dim wsCurrent As Worksheet, _
        loTable1 As ListObject, _
        lcColumns As ListColumns, _
        lrCurrent As ListRow

    Set wsCurrent = ActiveSheet
    Set loTable1 = wsCurrent.ListObjects("Table1")
    Set lcColumns = loTable1.ListColumns

    For i = 1 To loTable1.ListRows.Count
        Set lrCurrent = loTable1.ListRows(i)

        'Using position: Range(1, 2)
        Debug.Print lrCurrent.Range(1, 2)
        'Using header name: Range(1, 2)
        Debug.Print lrCurrent.Range(1, lcColumns("Column2").Index)
        'Using global range column values: Range(1, (4-2))
        Debug.Print lrCurrent.Range(1, (lcColumns("Column2").Range.Column - loTable1.Range.Column))
        'Using pure global range values: Range(5,4)
        Debug.Print wsCurrent.Cells(lrCurrent.Range.Row, lcColumns("Column2").Range.Column)
    Next i
End If

---

Оптимизированный код

Как и было обещано, вот оптимизированный код.

Public Sub Code()
    Dim wsCurrentSheet As Worksheet, _
        loSourceFiles As ListObject, _
        lcColumns As ListColumns, _
        lrCurrent As ListRow, _
        strFileNameDate As String

    Set wsCurrentSheet = Worksheets("Lists")
    Set loSourceFiles = wsCurrentSheet.ListObjects("tblSourceFiles")
    Set lcColumns = loSourceFiles.ListColumns

    For i = 1 To loSourceFiles.ListRows.Count
        Set lrCurrent = loSourceFiles.ListRows(i)

        If InStr(lrCurrent.Range(1, lcColumns("Column Name").Index), "DATE") <> 0 Then
            strSrc = lrCurrent.Range(1, lcColumns("New File Name").Index).value
            strReplace = Format(ThisWorkbook.Names("ValDate").RefersToRange, "yyyymmdd")

            strFileNameDate = Replace(strSrc, "DATE", strReplace)
            wbName = OpenCSVFile("Path" & strFileNameDate)
            CopyData sourceFile:=CStr(strFileNameDate), _
                     destFile:="file", _
                     destSheet:="temp"
        End If
    Next i
End Sub

---

Ссылки

Личный опыт.

MSDN

• ListObject
• ListColumns
• ListRows

Answer 2

Это удобная функция:

Function rowCell(row As ListRow, col As String) As Range
    Set rowCell = Intersect(row.Range, row.Parent.ListColumns(col).Range)
End Function

Answer 3

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

Следующий код обернет объект строки списка в коллекцию:

Function lrWrap(lr As ListRow, lo As ListObject) As Collection
    Dim vh As Variant: vh = lo.HeaderRowRange.Value 'Header
    Dim vr As Variant: vr = lr.Range.Value          'This row
    Dim retCol As New Collection

    'Append list row and object to collection as __ListRow and __ListObject
    retCol.Add lr, "__ListRow"
    retCol.Add lo, "__ListObject"

    'Loop through each header and append row value with header as key into return collection
    For i = LBound(vh, 2) To UBound(vh, 2)
        retCol.Add vr(1, i), vh(1, i)
    Next

    'Return retCol
    Set lrWrap = retCol
End Function

В конечном итоге с помощью функции вы можете сделать следующее:

Dim MyListObject as ListObject, row as ListRow, col as Collection
set MyListObject = Sheets("MySheet").ListObjects("MyTableName")
For each row in MyListObject
    set col = lrWrap(row)
    debug.print col("My Table Header")

    'If you need to access the list object you can do so via __ListObject
    debug.print col("__ListObject").name
next

По моему мнению, это делает ваш код чертовски чище, чем все вышеперечисленное.

Answer 4

Если вы хотите найти конкретное значение в заголовке столбца, вы можете использовать метод find.Метод find возвращает диапазон, который затем можно использовать в качестве ссылки для выполнения оставшейся части операции.В методе find есть много необязательных параметров, читайте об этом в справочных документах, если вам нужно настроить их больше.

Dim cellsToSearch As Range
Dim foundColumn As Range
Dim searchValue As String

Set cellsToSearch = Sheet1.Range("A1:D1")  ' Set your cells to be examined here
searchValue = "Whatever you're looking for goes here"

Set foundColumn = cellsToSearch.Find(What:=searchValue)