|
|
很奇怪，第一个表竟然循环不到，代码仅从参考
Sub word到excel()
Application.ScreenUpdating = False
Dim FilePath As String
Dim i As Integer, n As Integer
Dim arr
Dim WordApp As Object
Set WordApp = CreateObject("Word.Application") '新建Word对象
WordApp.Visible = True
Dim WordD As Object
ReDim arr(1 To 100000, 1 To 5)
Set WordD = WordApp.Documents.Open(ThisWorkbook.Path & "\交易公司专业题库.docx")
On Error Resume Next
For s = 1 To WordD.tables.Count
Set ta = WordD.tables(s)
zd = ta.Cell(2, 3).Range.Text
For i = 2 To ta.Rows.Count
n = n + 1
For j = 1 To ta.Columns.Count
arr(n, j) = Replace(ta.Cell(i, j).Range.Text, Chr(13) & Chr(7), "")
Next j
Next i
Next s
WordD.Close
Set WordD = Nothing
WordApp.Quit
Range("a2").Resize(n, 5) = arr
Application.ScreenUpdating = True
MsgBox "完成"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-6-29 20:23
楼主
