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

前言

我通过谷歌找到了这个，我发现它缺乏。所以我将填写更多信息，解释发生了什么，并稍微优化代码。

说明

应该给你带来的明显答案是：
是的，可以做到。事实上，它比你想象的要简单。

我注意到你做了这个

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

它为您提供了标题“新文件名”的索引然后，当您决定检查列时，您忘记了索引实际上也是相对列位置。

因此，您应该完成与之前相同的事情

，而不是列号

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

让我们深入挖掘，不仅用文字解释，还用图片解释 Relative column index
在上图中，第一行显示绝对列索引，
其中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。

ListRow range
因此，例如，要在ListRow的每次迭代中引用Column2，您可以这样做

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

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

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

Answer 4

对我来说，最令人vo惜的答案太复杂了……这可能不是最理想的代码（您需要一个特殊的类来使其既简单又理想），但是它比大多数代码要快解决方案（可能包括最受欢迎的答案）

以下代码将列表行对象包装到集合中：

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

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

如何遍历表并按列标题访问行项？

4 个答案:

前言

说明

优化代码

参考