Excel VBA技术问题：需将表格遍历从按行改为按列循环

我有一个从PDF导入Excel 365的LTD表格，需要提取特定Lot详情用于其他场景。现有VBA代码能实现核心功能，但当前是按行横向遍历表格，输出格式可用性差，需要改成按列纵向遍历。仅读取表格数据，不写入，本以为只需调整循环顺序，但尝试后没成功。

原核心遍历代码 #

For Each cell In tblDBR
    Select Case cell.Column
    Case 3 To 13        
        If cell.Value <> 0 Then
            Process each formatted item and move to next formatted cell etc
        End If
    End Select
Next cell

原完整代码 #

Private Sub CommandButton1_Click()
    'Macro to loop through LTD table and write 'lot' information for use elsewhere
    Dim ws As Worksheet, tbl As ListObject, tblCol As ListColumn, cell As Range, tblCols As ListColumns, tblDataCol As Range, tblDBR As Range, POD As String

    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("LTD")
    Set tblDBR = tbl.DataBodyRange
    Set tblCols = tbl.ListColumns
    Set tblDataCol = tbl.ListColumns(3).DataBodyRange
    POD = "CHINA"

    Range("N6").Select      'location to start writing Lots - arbitrary
 
    For Each cell In tblDBR
 
    Select Case cell.Column
    Case 3 To 13        'always this many columns, always starts at 3
    
    If cell.Value <> 0 Then
        cell.Interior.ColorIndex = 6        'useful color changer to show progress and problem
        ActiveCell.Value = tbl.HeaderRowRange.Cells(1, cell.Column - tbl.Range.Column + 1).Value
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Lot " & cell.Offset(0, -(cell.Column - 1)).Value    'Lot Number
        ActiveCell.Offset(1, 1).Select
        ActiveCell.Value = cell.Offset(0, -(cell.Column - 2)).Value & " M"      'Length
        ActiveCell.Offset(0, -1).Select
        ActiveCell.Value = Application.WorksheetFunction.Round(cell.Value, 0)   'Volume
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Value = POD      'Disport
        ActiveCell.Offset(2, -1).Select  'move down a line and start again
    End If
    End Select
    Next cell
End Sub

调整后的按列遍历代码 #

核心思路是先遍历列，再遍历列中的每一行，同时优化Select操作以提升效率和稳定性：

Private Sub CommandButton1_Click()
    'Macro to loop through LTD table by columns and write 'lot' information for use elsewhere
    Dim ws As Worksheet, tbl As ListObject, tblDBR As Range, POD As String
    Dim col As Range, cell As Range
    Dim outputRow As Long ' 跟踪输出起始行，替代Select操作

    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("LTD")
    Set tblDBR = tbl.DataBodyRange
    POD = "CHINA"

    outputRow = 6 ' 输出起始行，对应原代码的N6位置

    ' 遍历表格第3到第13列（内部列索引）
    For Each col In tblDBR.Columns
        ' 转换为工作表列索引判断，确保只处理目标列
        If col.Column >= tbl.Range.Column + 2 And col.Column <= tbl.Range.Column + 12 Then
            ' 纵向遍历当前列的每一行
            For Each cell In col.Cells
                If cell.Value <> 0 Then
                    cell.Interior.ColorIndex = 6 ' 标记已处理单元格
                    
                    ' 直接赋值到输出区域，避免Select操作
                    ws.Cells(outputRow, "N").Value = tbl.HeaderRowRange.Cells(1, col.Column - tbl.Range.Column + 1).Value
                    ws.Cells(outputRow, "O").Value = "Lot " & tbl.DataBodyRange.Cells(cell.Row - tbl.Range.Row + 1, 1).Value ' 提取表格第1列的Lot编号
                    ws.Cells(outputRow + 1, "O").Value = tbl.DataBodyRange.Cells(cell.Row - tbl.Range.Row + 1, 2).Value & " M" ' 提取表格第2列的长度
                    ws.Cells(outputRow + 1, "N").Value = Application.WorksheetFunction.Round(cell.Value, 0) ' 处理后的体积
                    ws.Cells(outputRow + 2, "N").Value = POD ' 目的港
                    
                    outputRow = outputRow + 3 ' 每组数据占3行，输出位置下移3行
                End If
            Next cell
        End If
    Next col
End Sub

关键修改点说明 #

• 遍历顺序重构：从全局遍历单元格改为先遍历目标列，再遍历列内每行，实现纵向按列处理逻辑。
• 移除Select操作：用outputRow变量跟踪输出位置，直接通过单元格地址赋值，避免因Select导致的逻辑混乱和性能损耗。
• 列索引修正：将表格内部列索引（3-13）转换为工作表实际列索引判断，确保只处理指定范围的列。

内容的提问来源于stack exchange，提问作者Scott Knight