VBA宏优化需求：仅抓取企业内网指定类别的目标表格

我来帮你修改这个VBA宏，让它精准抓取包含TableTitle1和TableContent类的目标表格，而不是页面中所有表格。

首先，先看你提供的目标表格结构：

return (<TD width="3%"></TD><TD colSpan=4><TABLE borderColor=#ffffff cellSpacing=0 cellPadding=3 width="100%" border=1><TBODY><TR class=TableTitle1><TD vAlign=middle width=90 align=left>MOD Number (CIN)</TD><TD vAlign=middle width=250 align=left>Title</TD><TD vAlign=middle width=90 align=left>Leader (FIC)</TD><TD vAlign=middle width=49 align=left>ATA</TD><TD vAlign=middle width=72 align=left>Opening MP</TD><TD vAlign=middle width=88 align=left>Opening date</TD></TR><TR class=TableContent><TD><A href="/cmh/consultation/preViewMOD.do MODId=162615&amp;mpId=K20734&amp;isFrom=fromMP">162615</A><A href="/cmh/consultation/preViewCINData.do? MODId=162615&amp;MPId=K20734">(162615/K20734)</A></TD><TD>COMMUNICATIONS-PAX ENTERTAINMENT INSTALL PANASONIC EX1/EXW ON UNIVERSAL PLATFORM FOR ANZ06 VERSION</TD><TD>SA CCC</TD><TD>2333</TD><TD><A href="/cmh/consultation/preViewMP.do? mpId=K20734&amp;isFrom=fromMP">K20734</A></TD><TD>08-Aug-17</TD></TR><TR height=1 bgColor=white><TD colSpan=484></TD></TR></TBODY></TABLE></TD>
)

修改后的VBA代码片段 #

你可以在原代码的表格遍历部分加入筛选逻辑，只处理符合条件的表格：

Sub extract()
    Dim IE As Object, obj As Object
    Dim tbl As HTMLTable ' 明确表格对象类型
    Dim row As HTMLTableRow
    Dim hasTitle As Boolean, hasContent As Boolean
    Dim r As Long
    
    ' 假设你已经初始化了IE并加载了页面，这里省略这部分代码
    
    r = 1 ' 起始行号，根据你的需求调整
    ' 遍历页面中所有表格
    For Each tbl In IE.Document.getElementsByTagName("TABLE")
        hasTitle = False
        hasContent = False
        
        ' 检查当前表格内的所有行，判断是否包含目标类
        For Each row In tbl.getElementsByTagName("TR")
            If row.className = "TableTitle1" Then
                hasTitle = True
            ElseIf row.className = "TableContent" Then
                hasContent = True
            End If
            
            ' 一旦两个条件都满足，提前退出循环，提升效率
            If hasTitle And hasContent Then
                Exit For
            End If
        Next row
        
        ' 如果表格同时包含TableTitle1和TableContent行，就提取数据
        If hasTitle And hasContent Then
            ' 这里写你原来的表格数据提取逻辑，比如遍历行和单元格
            For Each row In tbl.getElementsByTagName("TR")
                ' 跳过空行或者分隔行（比如height=1的那行）
                If row.className = "TableTitle1" Or row.className = "TableContent" Then
                    Dim cell As HTMLTableCell
                    Dim c As Long
                    c = 1
                    For Each cell In row.getElementsByTagName("TD")
                        Cells(r, c).Value = cell.innerText ' 提取单元格文本
                        c = c + 1
                    Next cell
                    r = r + 1
                End If
            Next row
        End If
    Next tbl
    
    ' 清理对象
    Set IE = Nothing
End Sub

关键逻辑说明 #

• 表格筛选：通过遍历每个表格内的行，检查是否同时存在TableTitle1和TableContent类的行，只有符合这个条件的表格才会被处理。
• 数据提取优化：提取时跳过了无关的行（比如那个height=1的空白行），只提取表头和内容行的数据。
• 类型声明：使用HTMLTable、HTMLTableRow等明确的对象类型，让代码更稳定（需要确保你已经引用了Microsoft HTML Object Library，如果没有可以用Object类型替代）。

如果你的原代码里有初始化IE的部分，直接把这段筛选和提取逻辑替换进去就可以了，这样就能精准抓取你需要的目标表格啦！

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