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

Question

我有以下宏需要循环Excel-2007表。该表有几列，我目前使用qazxsw poi属性列找到正确的列位置。

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

此外，一般来说，有没有更好的方法来构建这个循环？

fName

Answer 1

如果要在列标题中查找特定值，可以使用find方法。 find方法返回一个范围，然后您可以将其用作执行其余操作的引用。 find方法有很多可选参数，如果需要进一步调整，请在帮助文档中阅读。

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 2

前言

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

说明

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

我注意到你这样做了

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)

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

因此，您应该完成与以前相同的操作，而不是列号

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

让我们深入挖掘，不仅用文字解释，而且用图片解释 在上图中，第一行显示绝对列索引， 其中A1的列索引为1，B1的列索引为2，依此类推。

InStr(fName.Range(1, filesToImport.ListColumns("Column Name")), "DATE") 的头文件有自己的相对索引，在这个例子中，Column1的列索引为1，Column2的列索引为2，依此类推。这允许我们在引用带有数字或名称的列时使用ListObject属性。

为了更好地演示，这里是一个代码，用于打印上一个图像中“Column1”的相对和绝对列索引。

ListRow.Range

由于

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

---

参考

个人经验。

MSDN

• 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

• ListObject
• ListColumns

Answer 3

这是一个方便的功能：

ListRows

Answer 4

对我来说，最受欢迎的答案感觉很复杂......这可能不是最优化的代码，（你需要一个特殊的类来使它既简单又优化），但它会比大多数解决方案更快（可能包括最受欢迎的答案）

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

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

最终使用该功能，您可以执行以下操作：

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

在我看来，这使得你的代码比上面的任何代码都要简洁得多。