vba 如何遍历表并按列标题访问行项目?

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/3070123/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 10:33:41  来源:igfitidea点击:

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

excel-vbaexcel-2007vbaexcel

提问by Ahmad

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 Indexproperty columns.

我有以下宏需要遍历 Excel-2007 表。该表有几列,我目前正在使用Index属性列找到正确的列位置。

Using the index is the only way I could find to correctly index into the fNameobject. 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?

使用索引是我能找到的正确索引fName对象的唯一方法。我希望更好的选择是使用列名称/标题访问特定列。我怎么能做到这一点,甚至可以做到这一点?

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

采纳答案by Michael

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.

如果要在列标题中查找特定值,可以使用 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)

回答by ShadowScripter

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
Relative column index
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.

再深挖一点,不仅用文字解释,还要用图片解释
相对列索引
上图中,第一行显示的是绝对列索引,
其中A1的列索引为1,B1的列索引为2,依此类推。

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.Rangeproperty when referencing the columns either with numbers or names.

所述ListObject的标头拥有自己的相关指标,其中,在该示例中,列1将具有列索引1,列2将具有列索引2,依此类推。这允许我们ListRow.Range在引用带有数字或名称的列时利用该属性。

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

为了更好地演示,这里有一个代码,用于打印上一张图像中“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

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

由于 theListRow.Range指的是范围,它成为一个相对性问题,因为该范围在ListObject.

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

列表行范围
因此,例如,在每次迭代中引用 Column2ListRow可以这样做

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

MSDN

回答by maybeWeCouldStealAVan

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

回答by Sancarn

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.

在我看来,这使您的代码比上述任何代码都要干净得多。