Excel VBA将word数据导入excel

Question

我是 VBA 新手，我想将单词表复制到 Excel，但我没有得到 REQ-加入excel，只是获取其他选项卡

输入:


期望的输出:


我得到的输出


代码:

Option Explicit
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim resultRow As Long
Dim resultCol As Long
Dim tableStart As Integer
Dim tableTot As Integer
On Error Resume Next
ActiveSheet.Range("A:AZ").ClearContents
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
    tableNo = wdDoc.Tables.Count
    tableTot = wdDoc.Tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf tableNo > 1 Then
        tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
        "Enter the table to start from", "Import Word Table", "1")
    End If
    resultRow = 2
    For tableStart = 1 To tableTot
        With .Tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                Range("A1") = "Description"
                Range("A1").Font.Bold = True
                Range("B1") = "Source"
                Range("B1").Font.Bold = True
                Range("C1") = "Rationale"
                Range("C1").Font.Bold = True
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cell(iCol, iRow).Range.Text)
                Next iCol
                resultRow = resultRow
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
End With
End Sub

Answer 1

为了使它起作用，需要进行一些调整:

On Error Resume Next已被删除。这不应该用于整个宏——它所做的只是隐藏错误，告诉你出了什么问题。如果错误经常发生，那么需要修复一些东西!这可用于特殊情况，但应重新启用错误处理。我在这段代码中没有看到特殊情况。

Word 和 Excel 都使用 Range ，因此指定范围的含义很重要。这在 Excel 中也很重要。依靠 VBA 来猜测某个范围在哪个工作表中可能会导致意想不到的结果。因此，Worksheet对象被声明并实例化到事件工作表。这个对象 - ws - 然后在整个代码中使用以清楚地识别所有 Range Excel 中的对象。

由于 Excel 中的列标题只需要编写一次，因此该代码已移出循环。此外，您提供的屏幕截图中没有标记第一列 (REQ)。所以标签应该从 B 列开始，而不是从 A 列开始——这些范围坐标已经相应地改变了。

使用已合并单元格的 Word 表格(屏幕截图中的第一列)总是很棘手。因此，获取 REQ 的代码被移到表格单元循环之外，并显式引用了第 1 行、第 1 列。

要传输的其余数据仅在第 3 列中，因此无需循环列，只需循环行。 Excel 范围的列说明符已修改为使用 irow + 1因为这给出了正确的结果。

Cell( ) method in Word is: .Cell(rowIndex, colIndex)` - 问题中发布的代码中的参数颠倒了。

以下代码在我的测试中适用于我:

Option Explicit

Sub ImportWordTable()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim tableNo As Integer 'table number in Word
    Dim iRow As Long 'row index in Excel
    Dim iCol As Integer 'column index in Excel
    Dim resultRow As Long
    Dim resultCol As Long
    Dim tableStart As Integer
    Dim tableTot As Integer
    Dim ws As Worksheet

    'On Error Resume Next

    Set ws = ActiveSheet
    ws.Range("A:AZ").ClearContents

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for file containing table to be imported")
    If wdFileName = False Then Exit Sub '(user cancelled import file browser)

    Set wdDoc = GetObject(wdFileName) 'open Word file

    With wdDoc
        tableNo = wdDoc.Tables.Count
        tableTot = wdDoc.Tables.Count
        If tableNo = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        ElseIf tableNo > 1 Then
            tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
            "Enter the table to start from", "Import Word Table", "1")
        End If
        resultRow = 2
        With ws
            .Range("B1") = "Description"
            .Range("B1").Font.Bold = True
            .Range("C1") = "Source"
            .Range("C1").Font.Bold = True
            .Range("D1") = "Rationale"
            .Range("D1").Font.Bold = True
        End With
        For tableStart = tableNo To tableTot
            With .Tables(tableStart)
                'copy cell contents from Word table cells to Excel cells
                '''REQ
                ws.Cells(resultRow, 1) = WorksheetFunction.Clean(.Cell(1, 1).Range.Text)
                For iRow = 1 To .Rows.Count
                    'For iCol = 1 To .Columns.Count
                     ws.Cells(resultRow, iRow + 1) = WorksheetFunction.Clean(.Cell(iRow, 3).Range.Text)
                    'Next iCol
                    resultRow = resultRow
                Next iRow
            End With
            resultRow = resultRow + 1
        Next tableStart
    End With
End Sub