How to loop though a table and access row items by their column header?

问题

I have the following macro which needs to loop though an Excel-2007 table. The table has several columns and I am currently finding the correct column position using the Index property columns.

Using the index is the only way I could find to correctly index into the fName object. The better option I am hoping for is to access specific columns using the Column Name/Header. How can I do this and can this be even done?

Furthermore, in general, is there a better way to construct this loop?

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

回答1:

If you want to find a specific value in a column heading, you can use the find method. The find method returns a range, which you can then use as a reference to perform the rest of the operation. There are a lot of optional parameter to the find method, read up on it in the help docs if you need to tweak it more.

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)

回答2:

Foreword

I found this through google, and I found it lacking. So I'm going to fill in some more information, explain what's going on and also optimize the code a bit.

Explanation

The obvious answer that should have been brought to you is:
Yes, it can be done. In fact, it's simpler than you'd think.

I noticed you did this

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

Which gave you the index of the header "New File Name".
Then, when you decided to check for the columns, you forgot that the index is actually the relative column position as well.

So, instead of a column number you should've done the same thing as before

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

Let's dig a little deeper, and explain with not only words, but with pictures

In the picture above, the first row shows the absolute column index,
where A1 has a column index of 1, B1 has a column index of 2 and so on.

The ListObject's headers have their own relative indexes, where, in this example, Column1 would have column index 1, Column2 would have column index 2 and so on. This allows us to utilize the ListRow.Range property when referencing the columns either with numbers or names.

To better demonstrate, here's a code that prints the relative and absolute column index of "Column1" from the previous image.

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

Since the ListRow.Range refers to the range, it becomes a matter of relativity because that range is inside the ListObject.

So, for example, to reference Column2 in each iteration of ListRow you could do like this

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

---

Optimized Code

As promised, here's the optimized code.

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

---

References

Personal experience.

MSDN

• ListObject
• ListColumns
• ListRows

回答3:

This is a handy function:

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

回答4:

The most upvoted answer feels over complicated to me... This may not be the most optimal code, (you'd need a special class to make it both simple and optimal for this), but it will be faster than most solutions (probably including the most upvoted answer)

The following code will wrap a list row object into a collection:

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

Ultimately with the function you can do the following:

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

This makes your code a hell of a lot cleaner than any of the above in my opinion.

来源：https://stackoverflow.com/questions/3070123/how-to-loop-though-a-table-and-access-row-items-by-their-column-header