添加转置excel VBA

我目前正在一个较大的项目中工作，在那里我将recive很多Word文档，我想转换成excell工作表，然后添加到Access数据库，我已经找到了第一部分VBA：添加转置excel VBA

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 

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 
    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 table number of table to import", "Import Word Table", "1") 
    End If 
    With .tables(TableNo) 
     'copy cell contents from Word table cells to Excel cells 
     For iRow = 1 To .Rows.Count 
      For iCol = 1 To .Columns.Count 
       Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
      Next iCol 
     Next iRow 
    End With 
End With 

Set wdDoc = Nothing 

End Sub

不过，我需要一种方法来转表没有保留原始数据，是有办法，我可以为了兼顾这两项工作任何形式的VBA代码添加到现有的代码？

来源

2017-07-24 Mikkel Astrup

难道ü尝试更换iRow和ICOL，细胞（ICOL，iRow）= WorksheetFunction.Clean（。细胞（iRow，ICOL ）.Range.Text） –

替换下面的代码，并检查是否这是你需要什么

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

来源

2017-07-24 11:34:39

惊人的，像预期的作品！谢谢 –

欢迎。谢谢 –

添加转置excel VBA

回答

相关问题