|
楼主 |
发表于 2020-1-12 22:59
|
显示全部楼层
Sub wordtoexcel()
Range("A2:J10000").ClearContents
Dim i%, j%, k%, myPath$, myFile$, arr(1 To 10000, 1 To 10)
Dim wdApp As New Word.Application
Dim wdD As Word.Document
myPath = ThisWorkbook.Path & "\"
myFile = Dir(myPath & "*.doc?")
Do While myFile <> ""
Set wdD = wdApp.Documents.Open(myPath & myFile)
With wdD.Tables(1)
For i = 1 To .Rows.Count
If InStr(.cell(i, 6).Range.Text, "供电车间") Then
k = k + 1
arr(k, 1) = .cell(i, 1).Range.ListFormat.ListString & .cell(i, 2).Range.Text
arr(k, 1) = Replace(Replace(arr(k, 1), Chr(7), ""), "项", "")
For j = 2 To 10
arr(k, j) = Replace(Replace(.cell(i, j).Range.Text, Chr(7), ""), Chr(10), "")
Next
End If
Next
End With
wdD.Close
myFile = Dir
Loop
Range("A2").Resize(UBound(arr), 10) = arr
wdApp.Quit
Set wdD = Nothing
Set wdApp = Nothing
End Sub
以上是大神加了去除word自动编号后的代码 |
|