求助! 想把如下整个过程写成一个vba 。excel或者word的都行!请高手帮忙

qq_37339100 2017-01-18 02:31:42








...全文
929 1 收藏 3
写回复
3 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
lt0314 2017-03-14
Sub TableDoc2Xls()
Dim tb As Table, ce As Cell, ro As Row, r As Index, c As Index, dic As Object, ex As Object
Dim tt As String, arr
Set dic = CreateObject("scripting.dictionary")
For Each tb In ThisDocument.Tables
    For Each ro In tb.Rows
        tt = ""
        For Each ce In ro.Cells
            tt = tt & "`" & ce.Range.Text
        Next
        tt = Replace(Mid(tt, 2, 99999), Chr(13) & Chr(7), "")
        dic(tt) = Split(tt, "`")
    Next
Next
arr = dic.items
Set ex = CreateObject("excel.application")
With ex
    .Visible = True
    .workbooks.Add
    .sheets(1).Cells(1, 1).Resize(UBound(arr) + 1, UBound(arr(0)) + 1) = arr2xlarr(arr)
End With
End Sub
Function arr2xlarr(arr)
Dim tarr(), i As Integer, j As Integer, rs As Integer, cs As Integer
rs = UBound(arr) + 1: cs = UBound(arr(0)) + 1
ReDim tarr(rs, cs)
For i = 1 To rs
    For j = 1 To cs
        tarr(i, j) = arr(i - 1)(j - 1)
    Next
Next
arr2xlarr = tarr
End Function
回复
X-i-n 2017-02-01
很简单的需求,但是这个问题价值超过200分
回复
dsd999 2017-01-23
有点复杂,会录制宏吗?录制一次操作,然后试着改改 。
回复
相关推荐
发帖
Office开发/ VBA
创建于2007-08-27

4998

社区成员

其他开发语言 Office开发/ VBA
申请成为版主
帖子事件
创建了帖子
2017-01-18 02:31
社区公告
暂无公告