【已解决】求 很繁琐的文本数据整理 VBA 解法

排序难题

···············
各位老师好
今有一难题。。。
之前找了很多文本整理软件，都没看到能最终实现此文本处理的工具
在EXCEL里要处理起来很是繁琐。

我是先查找 含有｛3D  文本的所有行数，然后删除，然后查找含有 :2-3 的所有行数，再删除，然后……
嗯好繁琐。。。

在此向各位老师求解，，
能不能用VBA一键解决了

问题见附件，万分感谢
待处理就是要整理的文本，处理后的就是想要的结果的文本。。。
···
太诡异了，原来的文本居然每行都加了""
实际中是不需要这些“”的，
重新上传 help2.rar (1.96 KB, 下载次数: 16)

2009-10-22 15:13 上传

点击文件名下载附件

[ 本帖最后由 排序难题 于 2009-10-22 18:52 编辑 ]

排序难题

待处理就是要整理的文本，处理后的就是想要的结果的文本。。。

alzeng

1. 
   
2. Private Sub CommandButton1_Click()
   
3.     Dim irow%
   
4.     Dim str$, k%
   
5. 
   
6.     k = 0
   
7.     Open ThisWorkbook.Path & "\成组数据.txt" For Output As #1
   
8.     For irow = 1 To [A65536].End(3).Row
   
9.         If Cells(irow, 1) Like "?=*" Then
   
10.             str = ""
    
11.             For k = 0 To 2
    
12.                 str = str & Replace(Split(Cells(irow + k, 1), "=")(1), " ", "")
    
13.             Next
    
14.             str = Left(str, Len(str) - 1)
    
15.             Print #1, str
    
16.             irow = irow + 3
    
17.         End If
    
18.     Next
    
19.     Close #1
    
20. End Sub
    

复制代码

alzeng

处理数据.rar (9.44 KB, 下载次数: 12)

2009-10-22 11:47 上传

点击文件名下载附件

joforn

原帖由 排序难题 于 2009-10-22 11:26 发表
此求助已发悬赏，请老师们移驾
http://club.excelhome.net/viewth ... eward&frombbs=1
···············
各位老师好
今有一难题。。。
之前找 ...

1. 
   
2. Public Function 文本处理(ByVal FileName1 As String, ByVal FileName2 As String)
   
3.   Dim I As Long, FileL As Long
   
4.   Dim byteD() As Byte
   
5.   Dim strFiles() As String, strFile As String
   
6.   
   
7.   On Error Resume Next
   
8.   
   
9.   FileL = FileLen(FileName1)
   
10.   If FileL > 0 Then
    
11.     ReDim byteD(FileL - 1)
    
12.     FileL = FreeFile
    
13.     Open FileName1 For Binary As FileL
    
14.     Get FileL, , byteD
    
15.     Close FileL
    
16.     strFile = StrConv(byteD, vbUnicode)
    
17.     Erase byteD
    
18.     strFiles = Split(Replace(Replace(strFile, """", vbNullString), " ", vbNullString), vbCrLf)
    
19.     strFile = vbNullString
    
20.     For I = 0 To UBound(strFiles)
    
21.       Select Case True
    
22.         Case Mid(strFiles(I), 1, 1) = ":":          strFile = Mid(strFile, 1, Len(strFile) - 1) & vbCrLf
    
23.         Case IsNumeric(Split(strFiles(I), "=")(0)): strFile = strFile & Replace(Split(strFiles(I), "=")(1), " ", vbNullString)
    
24.       End Select
    
25.     Next I
    
26.     byteD = StrConv(strFile, vbFromUnicode)
    
27.     FileL = FreeFile
    
28.     If Len(Dir(FileName2, vbHidden Or vbNormal Or vbReadOnly Or vbSystem Or vbArchive)) Then
    
29.       SetAttr FileName2, vbNormal
    
30.       Kill FileName2
    
31.     End If
    
32.     Open FileName2 For Binary As FileL
    
33.     Put FileL, , byteD
    
34.     Close FileL
    
35.   End If
    
36. End Function
    
37. 
    
38. Public Sub Test()
    
39.   文本处理 ThisWorkbook.Path & "\待处理.txt", ThisWorkbook.Path & "\处理1.txt"
    
40. End Sub
    

复制代码

lb_bn

不知是不是这样。

smhf_6

从已有的数据看，
三楼Like "?=*" 这个可行，
还有用len()=x,也行
至于后面的处理，没什么问题了

其实，这个文本是中规中矩的，在实际工作中碰到的文本，比这个要复杂不知几十倍的比比皆是

[ 本帖最后由 smhf_6 于 2009-10-22 12:41 编辑 ]

排序难题

原帖由 alzeng 于 2009-10-22 11:46 发表

Private Sub CommandButton1_Click()
    Dim irow%
    Dim str$, k%

    k = 0
    Open ThisWorkbook.Path & "\成组数据.txt" For Output As #1
    For irow = 1 To [A65536].End(3).Row
        If C ...

谢谢老师。。。。

排序难题

原帖由 lb_bn 于 2009-10-22 12:27 发表
不知是不是这样。

老师 你的 在 待处理 文本里每行都加了 “”
这样的话我操作起来不方便了。。。
难道还要我先每行都加上“”，再执行 VBA？

排序难题

原帖由 alzeng 于 2009-10-22 11:47 发表
601659

老师把代码改成读取 待处理 文本，然后再执行VBA吧，
老师的代码很精简···

再次感谢