|
由于分列没有规律（或者我没有看出来），我所能做的，只有这个了： 以下代码供参考： '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-4-14 14:57:38
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－Sub WriteInExcel()
Dim ExcelSheet As Object, i As Paragraph, MyRange As Range, A As String, B As String
Dim MyArray() As String, aArray As Variant, RowIndex As Long, ColIndex As Integer, Temp As Long
Set ExcelSheet = CreateObject("Excel.Sheet") '创建一个后期绑定的EXCEL工作表对象
With ThisDocument '本文档
For Each i In .Paragraphs '在本文档的段落中循环
If VBA.InStr(i.Range, "Table") = 0 Then '如果不包括TABLE文本的段落
Set MyRange = .Range(i.Range.Start, i.Range.End - 1) '定义一个RANGE对象,不包括段落标记
'定义一个行号,为EXCELSHEET的A列最后一行
RowIndex = VBA.IIf(Temp = 0, 1, ExcelSheet.sheets(1).[A65536].End(-4162).Row + 1)
ColIndex = 0: Temp = Temp + 1
A = VBA.Replace(MyRange, "-", "") '将RANGEC对象文本中的"-"全部替换
B = VBA.Replace(A, " ", ",") '将A变量中的" "(连续两个空格)全部替换为,号
MyArray() = VBA.Split(B, ",") '以,为分隔符取得数组
For Each aArray In MyArray '在数组中循环
If aArray <> "" And aArray <> " " Then '如果不为空和空格则
ColIndex = ColIndex + 1 '列数累计
'写入EXCELSHEET的相应单元格中
ExcelSheet.sheets(1).Cells(RowIndex, ColIndex) = aArray
End If
Next
End If
Next
End With
With ExcelSheet
.SaveAs "D:\Example.xls" '保存此对象,请在此修改相应路径和文件名
.Application.Quit '退出EXCEL
Set ExcelSheet = Nothing '释放对象变量
End With
End Sub
'----------------------
| 
楼主: daviddong
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2005-4-14 14:58