从Microsoft Word中的表中检索文本？

我有一个像这样的文字文件：

Table 1 Table 2 Some Text My Value 

我想在Excel中使用VBA来检索表2中的文本，并将其放入我的表（“计算”）。

出于某种原因，这是行不通的，我的工作表上没有任何值。 我没有错误。

这是我的代码：

 Sub ImportWordTable() 'Application.ScreenUpdating = False 'Application.DisplayAlerts = False 'Application.EnableEvents = False 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 wdFileName = Worksheets("Calculations").Range("A1").Value & "\" & AlphaNumericOnly(Worksheets("Supplier").Range("O" & ActiveCell.Row).Value) & "_CAP_" & Replace(Worksheets("Supplier").Range("T" & ActiveCell.Row).Value, "/", ".") & ".doc" If wdFileName = False Then Exit Sub '(user cancelled import file browser) Set wdDoc = GetObject(wdFileName) 'open Word file MsgBox wdDoc With wdDoc TableNo = wdDoc.Tables.Count If TableNo = 0 Then ElseIf TableNo > 1 Then TableNo = "2" End If With .Tables(TableNo) 'copy cell contents from Word table cells to Excel cells For iRow = 1 To Worksheets("Calculations").Rows.Count For iCol = 1 To Worksheets("Calculations").Columns.Count Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text) Next iCol Next iRow End With End With Set wdDoc = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub Function AlphaNumericOnly(strSource As String) As String Dim i As Integer Dim strResult As String For i = 1 To Len(strSource) Select Case Asc(Mid(strSource, i, 1)) Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space strResult = strResult & Mid(strSource, i, 1) End Select Next AlphaNumericOnly = strResult End Function 

请有人告诉我我要去哪里错了吗？

Answer 1

你为什么循环浏览工作表的行和列？

 With .Tables(TableNo) 'copy cell contents from Word table cells to Excel cells For iRow = 1 To Worksheets("Calculations").Rows.Count For iCol = 1 To Worksheets("Calculations").Columns.Count Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text) Next iCol Next iRow End With 

您需要遍历表格的行和列。 试试这个（ 未经testing ）

 Dim excelRow As Long, excelCol As Long excelRow = 1 With .Tables(TableNo) 'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count excelCol = 1 For iCol = 1 To .Columns.Count Worksheets("Calculations").Cells(excelRow, excelCol) = _ WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text) excelCol = excelCol + 1 Next iCol excelRow = excelRow + 1 Next iRow End With 

编辑

我testing了这个，它的工作原理

码

 Sub ImportWordTable() Dim oWordApp As Object, wdDoc As Object Dim iRow As Long, iCol As Long Dim excelRow As Long, excelCol As Long Dim Filename As String Filename = "C:\Users\Siddharth\Desktop\DeleteMeLater.docx" Set oWordApp = CreateObject("Word.Application") oWordApp.Visible = True Set wdDoc = oWordApp.Documents.Open(Filename) With wdDoc If wdDoc.Tables.Count > 1 Then With .Tables(2) excelRow = 1 'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count excelCol = 1 For iCol = 1 To .Columns.Count Worksheets("Calculations").Cells(excelRow, excelCol) = _ WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text) excelCol = excelCol + 1 Next iCol excelRow = excelRow + 1 Next iRow End With End If End With Set wdDoc = Nothing End Sub