使用 VBA 将表格从 Word 导入并格式化为 Excel

Question

嗨 StackOverflow 社区。 我是 VBA 编码的新手，正在尝试将表格数据从 Word 文档导入到 Excel。

Word 文档中的表格数量将固定为 5，每个特定表格中的行数和列数也将固定为 5。

我成功导入了所有数据，但下一步，我想格式化导入的数据，我似乎无法弄清楚。

请查看下面插入的图片，了解我得到的结果以及我想要得到的结果。

我得到的 Output

Output 我想得到

请找到我在下面编写的代码：

Sub CommandButton1_Click()
'Declare variables
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim tableNo As Integer
    Dim irow As Long
    Dim icolumn As Long
    row_number = 1
    col_number = 1
    
    'Open specific Word-document to import table
    wdFileName = Application.GetOpenFilename("Word File(*.docx), *.docx", , "Select Word File", , False)
    
    If wdFileName = False Then Exit Sub
    
    Set wdDoc = GetObject(wdFileName)
    With wdDoc
        'Count the number of tables
        tableNo = .tables.Count
        If tableNo = 0 Then
            MsgBox "There are no tables in the specified Word Document. Please select the correct Word Document"
        Else
            'Import of text/data in the tables from Word-document to specified range in Excel. Starts with table 1, then 2 and so on
            For i = 1 To 1
                With .tables(i)
                    For icolumn = 1 To .Rows.Count
                        Application.Range("C6:D7").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
                        Application.Range("C6:D7").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)

                        col_number = col_number + 1
                        row_number = row_number + 1
                    Next icolumn
                End With
            Next i
            
            For i = 2 To 2
                With .tables(i)
                    For icolumn = 1 To .Rows.Count
                        Application.Range("C7:D8").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
                        Application.Range("C7:D8").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)

                        col_number = col_number + 1
                        row_number = row_number + 1
                    Next icolumn
                End With
            Next i
            
            For i = 2 To 2
                With .tables(i)
                    For icolumn = 1 To .Rows.Count
                        Application.Range("C8:D9").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 3).Range.Text)
                        Application.Range("C8:D9").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 4).Range.Text)

                        col_number = col_number + 1
                        row_number = row_number + 1
                    Next icolumn
                End With
            Next i
            
            For i = 3 To 3
                With .tables(i)
                    For icolumn = 1 To .Rows.Count
                        Application.Range("C9:D10").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 3).Value = WorksheetFunction.Clean(.cell(icolumn, 3).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 4).Value = WorksheetFunction.Clean(.cell(icolumn, 4).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 5).Value = WorksheetFunction.Clean(.cell(icolumn, 5).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 6).Value = WorksheetFunction.Clean(.cell(icolumn, 6).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 7).Value = WorksheetFunction.Clean(.cell(icolumn, 7).Range.Text)
                        Application.Range("C9:D10").Cells(col_number, 8).Value = WorksheetFunction.Clean(.cell(icolumn, 8).Range.Text)

                        col_number = col_number + 1
                        row_number = row_number + 1
                    Next icolumn
                End With
            Next i
            
            For i = 4 To 4
                With .tables(i)
                    For icolumn = 1 To .Rows.Count
                        Application.Range("C10:D11").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
                        Application.Range("C10:D11").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)

                        col_number = col_number + 1
                        row_number = row_number + 1
                    Next icolumn
                End With
            Next i
            
            For i = 5 To 5
                With .tables(i)
                    For icolumn = 1 To .Rows.Count
                        Application.Range("C11:D12").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
                        Application.Range("C11:D12").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)

                        col_number = col_number + 1
                        row_number = row_number + 1
                    Next icolumn
                End With
            Next i
            
    End If
    End With
End Sub

我希望社区可以为此提供帮助:)

Answer 1

转置表 3 以外的行和列。

Sub CommandButton1_Click()

    Dim wdDoc As Object, wdFileName As Variant, tbl As Word.Table
    Dim ws As Worksheet, rng As Range, tableNo As Integer
    Dim r As Long, c As Long
    
    'Open specific Word-document to import table
    wdFileName = Application.GetOpenFilename("Word File(*.docx), *.docx", , "Select Word File", , False)
    
    If wdFileName = False Then Exit Sub
    Set wdDoc = GetObject(wdFileName)
    
    'Count the number of tables
    tableNo = wdDoc.Tables.Count
    If tableNo < 5 Then
        MsgBox "There are not 5 tables in the specified Word Document. Please select the correct Word Document", vbExclamation
        Exit Sub
    End If
    
    Set ws = ActiveSheet 'ThisWorkbook.Sheet(1) '
    For tableNo = 1 To 5
        Set tbl = wdDoc.Tables(tableNo)
        
        Select Case tableNo
            Case 1:
                               
                Set rng = ws.Range("C6") ' top left corner
                ' transpose rows / cols
                For r = 1 To 2
                    For c = 1 To 2
                        rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
                    Next
                Next
                
            Case 2:
                               
                Set rng = ws.Range("C9")
                ' transpose rows / cols
                For r = 1 To 2
                    For c = 1 To 3
                        rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
                    Next
                Next
                
                Set rng = ws.Range("C12")
                ' transpose rows / cols
                For r = 3 To 4
                    For c = 1 To 3
                        rng.Offset(r - 3, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
                    Next
                Next
                 
            Case 3:
            
                Set rng = ws.Range("C17")
                For r = 1 To tbl.Rows.Count
                    For c = 1 To 8
                        rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(r, c).Range.Text)
                    Next
                Next
                
            Case 4:
            
                Set rng = ws.Range("C26")
                ' transpose rows / cols
                For r = 1 To 2
                    For c = 1 To 3
                        rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
                    Next
                Next
                
            Case 5:
            
                Set rng = ws.Range("C29")
                ' transpose rows / cols
                For r = 1 To 2
                    For c = 1 To 4
                        rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
                    Next
                Next
                
        End Select
        
    Next
    Set wdDoc = Nothing
    MsgBox "Done", vbInformation

End Sub