用vba提取表格的问题

citykunan

如附件的doc文件，如何用vba判断表格的第一个是Model Number的字符串，然后就把表格的内容提取到txt文档，并且同一行用逗号分割，如附件的txt文件？任何意见，万分感谢。

bseYNjqR.zip (7.41 KB, 下载次数: 32)

2007-3-13 09:28 上传

点击文件名下载附件
用vba提取表格的问题

守柔

欢迎citykunan！

您的意思是，在一个文档中，有很多类似的表格，如果表格的第一个单元格的文本内容为“Model Number”，则提取表格内容到文本文件中，并以逗号分隔。

请问：文本文件中的每个“表格”内容之间有无要求？WORD文档中的表格中是否会存在行列不均匀（即有合并单元格）的情况？如果有，如果设置规则？

citykunan

谢谢版主的回答，版主的理解完全正确，文本文件中的每个“表格”内容之间无要求，表格是一行，提取成文本文件就是一行，以逗号分割。每个表格都是均匀的，只是可能某个单元个可能没有值，如第三行，remark这一列是没有值的，就不用提取了。能不能做呢？谢谢。

konggs

'生成一个txt文档
Sub DocTabletotxt()
    Dim mytable As Table
    Dim mystring As String, allstring As String
    Dim temp As String
    Dim tempTablestring
    Dim i, k
    Const ConstText = "Model Number"
    '
    For Each mytable In ActiveDocument.Tables '在表格内循环
        temp = Left(mytable.Range.Cells(1).Range.Text, Len(mytable.Range.Cells(1).Range.Text) - 2) '去掉最后两个Chr(13)&Chr(7)
        If temp = ConstText Then 'if is ModelNumber
           tempTablestring = Split(mytable.Range, VBA.ChrW(13) & VBA.ChrW(7) & VBA.ChrW(13) & VBA.ChrW(7)) '用列来分隔
           For Each i In tempTablestring '在行中循环
                tempTablestring(k) = Replace(tempTablestring(k), VBA.ChrW(13) & VBA.ChrW(7), ",") '替换掉回车加竖线
                tempTablestring(k) = Replace(tempTablestring(k), "," & VBA.ChrW(160), "") '替换你所谓的空格
                k = k + 1
           Next
           mystring = Join(tempTablestring, vbCrLf) '用回车连起来
        End If
        allstring = allstring & mystring '全部写入变量
    Next
    CreateAfile allstring, ActiveDocument.Path '创建txt文档
    MsgBox "创建成功！" '创建成功
End Sub
Function CreateAfile(allstring As String, myPath As String)
  Dim fso, MyFile
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set MyFile = fso.CreateTextFile(myPath & "\konggs.txt", 2, True) '创建文档，用来写操作
  MyFile.Write allstring    '变量内容全部传入txt文档
  MyFile.Close '关闭txt文档
End Function

citykunan

谢谢，真是厉害：）

citykunan

版主基本可以了，但是如果有连个表格在一个文档中，我只想把Model Number表头的东西提取出来，而不想把aaa表头的东西提取出来，但是实际上程序提取了两边的Model Number表头的东西，这是怎么一会事呢？谢谢

Model Number,Level,Acount,Remark
lw2,A,2,Have
sw4,A,3
hw5,B,3,Have
Model Number,Level,Acount,Remark
lw2,A,2,Have
sw4,A,3
hw5,B,3,Have

 

VlNxbjTj.zip (11.98 KB, 下载次数: 14)

2007-3-13 16:23 上传

点击文件名下载附件
用vba提取表格的问题

守柔

我也做了一个，供大家参考：

Option Explicit
Sub Example()
    Dim oTable As Table, oRow As Row, oString As String
    Dim myLabel As String, myTXT As String, txtFile As Object
    Dim FSO As Object, myArray() As String
    myLabel = "Model Number"
    myTXT = "D:\Excel_Home"
    If Dir(myTXT, vbDirectory) = "" Then VBA.MkDir myTXT
    myTXT = myTXT & "\" & myLabel & ".Txt"
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set txtFile = FSO.CreateTextFile(myTXT, True)
    For Each oTable In ActiveDocument.Tables
        With oTable
            If .Cell(1, 1).Range.Text = myLabel & Chr(13) & Chr(7) Then
                For Each oRow In .Rows
                    oString = oRow.Range.Text
                    oString = VBA.Mid(oString, 1, Len(oString) - 1)
                    myArray = VBA.Split(oString, Chr(13) & Chr(7))
                    oString = VBA.Join(myArray, ",")
                    oString = Application.CleanString(oString)
                    oString = Mid(oString, 1, Len(oString) - 2)
                    txtFile.WriteLine (oString)
                Next
            End If
        End With
    Next
    txtFile.Close
    ActiveDocument.FollowHyperlink myTXT
End Sub

citykunan

谢谢 守柔。 ：）也谢谢konggs

joney_154

真是高手,谢谢您们的回答!学习了...