VB 处理文本文件问题，急！！！

ajunajun 2010-03-24 12:57:58
原有文件内容如下：
200801010000（日期+时间，即2008年1月1日0点的60个分钟数据） 02 60（表示有60个数据）
00 01
012395 029550
012390 029560
012395 029560
012395 029555
012390 029560
012395 029555
……
200801010100 02 60
00 01
012390 029550
012395 029545
012390 029545
……

说明：
1、将上述橙色数据以一个新的一列的文本文件输出，格式如下：
029550
029560
029560
029555
029560
029555
……
029550
029545
029545
……

2、正常情况下每天有24个小时的数据（即24小时*60个/小时=1440个），但其中会有1个小时的60个数据重复。重复的格式如下：
200801010100 02 60
00 01
012390 029550
012395 029545
012390 029545
……
200801010100 02 60
00 01
012390 029550
012395 029545
012390 029545
……
'（即数据是一摸一样的），但只要其中的一个。
3、有时数据会缺测，比方一个文件里只有“5点到7点+13点到20点”的数据，其他时间的都没有，没有的都用“999999”代替，输出内容如下：
999999
999999
999999
……
'（0点到4点缺测数据）
029555
029560
029555
……
'（5点到7点完整数据）
999999
999999
999999
……
’（8点到12点缺测数据）
029555
029560
029555
……
'（13点到20点完整数据）
999999
999999
999999
……
’（21点到23点缺测数据）
...全文
310 29 打赏 收藏 转发到动态 举报
写回复
用AI写文章
29 条回复
切换为时间正序
请发表友善的回复…
发表回复
嗷嗷叫的老马 2010-03-25
  • 打赏
  • 举报
 回复
[Quote=引用 2 楼 bestbadgod 的回复:]
我很好奇红色标题怎么写出来的。
[/Quote]
说不定是刚改版的结果.

新的技术问题,分值>=100就自动红色醒目?
舉杯邀明月 2010-03-25
  • 打赏
  • 举报
 回复
先凑个热闹…………
king06 2010-03-25
  • 打赏
  • 举报
 回复
[Quote=引用 21 楼 myjian 的回复:]
引用 2 楼 bestbadgod 的回复:
我很好奇红色标题怎么写出来的。

说不定是刚改版的结果.

新的技术问题,分值>=100就自动红色醒目?
[/Quote]很有想法
LinTx_ 2010-03-25
  • 打赏
  • 举报
 回复
我的是用正则匹配下列格式的字符串：
8个数字+2位数字+2位数字+任意字符+换行+
任意字符+
60个[6个数字+空格+6个数字+任意字符+换行]

然后取出其中蓝色标记的数字作为小时，红色的作为数据

循环：
检查蓝色标记数字是否大于等于上次记录的小时数+1
蓝色数字是否大于0
大于0就用循环补充0点到蓝色数字之前一个小时，每个小时60个999999的数据
然后再添加这个小时数的60个数据
循环。。。
用1点60个数据、1点和2点分别60个数据这两种数据测试，结果正确
liguicd 2010-03-25
  • 打赏
  • 举报
 回复
围观 ....
倒大霉的上帝 2010-03-25
  • 打赏
  • 举报
 回复
[Quote=引用 22 楼 caozhy 的回复:]
引用 21 楼 myjian 的回复:
引用 2 楼 bestbadgod 的回复:
我很好奇红色标题怎么写出来的。

说不定是刚改版的结果.

新的技术问题,分值>=100就自动红色醒目?

同好奇。。。感觉问题没什么特别的啊。
[/Quote]
前一段时间在.net版也看到红色标题。估计半个月以前吧，所以肯定跟版本无关的。估计捅到了CSDN的那根神经了，染红了
LinTx_ 2010-03-25
  • 打赏
  • 举报
 回复 
'引用Microsoft   VBScript   Regular   Expressions   5.5

'窗体中两个textbox，一个按钮command1，text1存放原始数据，text2存放处理后的数据

Private Sub Command1_Click()

Dim re

Dim mc As MatchCollection

Dim m As Match

Dim i As Long

Dim sms As SubMatches

Dim j As Integer

Dim n As Integer



j = 0

Set re = New RegExp

re.Global = True

re.Pattern = "[\d]{8}([\d]{2})[\d]{2}.*\n.*" & SetPattern("", 60)

    

Set mc = re.Execute(Text1.Text)

Text2.Text = ""

For Each m In mc

    'MsgBox m.Value

    Set sms = m.SubMatches

    If CInt(sms.Item(0)) >= j Then

        If CInt(sms.Item(0)) <> j Then

            For i = j To CInt(sms.Item(0)) - 1

            Me.Caption = "正在处理" & i & "点的数据。"

            DoEvents

                For n = 1 To 60

                    Text2.Text = Text2.Text & "999999" & vbCrLf

                Next n

            Next i

        End If

        Me.Caption = "正在处理" & CInt(sms.Item(0)) & "点的数据。"

        DoEvents

        For i = 1 To sms.Count - 1

            Text2.Text = Text2.Text & sms.Item(i) & vbCrLf

        Next i

        j = CInt(sms.Item(0)) + 1

    End If

    Set sms = Nothing

Next m

If j < 24 Then

    For i = j To 23

    Me.Caption = "正在处理" & i & "点的数据。"

    DoEvents

        For n = 1 To 60

            Text2.Text = Text2.Text & "999999" & vbCrLf

        Next n

    Next i

End If

MsgBox "处理完毕！", vbInformation, "提示"

End Sub



Function SetPattern(Pattern As String, num As Integer) As String

If num = 1 Then SetPattern = Pattern & "\n[\d]{6} ([\d]{6}).*" Else SetPattern = Pattern & "\n[\d]{6} ([\d]{6}).*" & SetPattern(Pattern, num - 1)

End Function
skylinecn 2010-03-25
  • 打赏
  • 举报
 回复
改好了，楼主再试试。



Private Sub Command1_Click()

Dim ss$(), s1$(), s$, StrSS$, i&, j&, s2$, n&

ss = Split(Form1.RichTextBox1.Text, vbCrLf)

For i = 0 To UBound(ss)

    If InStr(ss(i), " 02 60") = InStrRev(ss(i), " 02 60") And InStr(ss(i), " 02 60") > 0 Then

        If 0 = InStr(s, ss(i)) Then

            If s2 = "" Then

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            Else

                n = DateDiff("h", s2, Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")) - 1

                If n > 0 Then

                    For i1 = 1 To n * 60

                        StrSS = StrSS & "999999" & vbCrLf

                    Next i1

                End If

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            End If

            s = s & ss(i) & vbCrLf

            i = i + 1

            For j = i To UBound(ss)

                If Len(ss(j)) > 7 Then

                    If InStr(ss(j), " 02 60") = InStrRev(ss(j), " 02 60") And InStr(ss(j), " 02 60") > 0 Then

                        i = j - 1: Exit For

                    Else

                        s1 = Split(ss(j), " ")

                        StrSS = StrSS & s1(1) & vbCrLf

                    End If

                End If

            Next j

        End If

    End If

Next i

'MsgBox StrSS

Open "d:\test.txt" For Output As #1: Print #1, StrSS: Close #1'路径自己按需修改

End Sub
threenewbee 2010-03-25
  • 打赏
  • 举报
 回复
[Quote=引用 21 楼 myjian 的回复:]
引用 2 楼 bestbadgod 的回复:
我很好奇红色标题怎么写出来的。

说不定是刚改版的结果.

新的技术问题,分值>=100就自动红色醒目?
[/Quote]
同好奇。。。感觉问题没什么特别的啊。
vbman2003 2010-03-24
  • 打赏
  • 举报
 回复 


    Dim hFile As Long

    Dim sFile As String

    Dim tmp As String

    Dim arrResult() As String

    Dim x As Long, y As Long

    Dim n As Long

    

    Const LENGTH = 23 * 60 + 60 - 1 '0 to 1440-1

    

    '初始化结果数组

    ReDim arrResult(LENGTH)

    For x = 0 To LENGTH

        arrResult(x) = "999999"

    Next x

    

    '一次读取文本内容

    hFile = FreeFile

    Open "E:\test.txt" For Binary As hFile

        sFile = Space(LOF(hFile))

        Get #hFile, , sFile

    Close

    

    x = InStr(sFile, vbCrLf)

    Do While x > 0

        tmp = Trim(Mid(sFile, y + 1, x - y - 1)) '截取一断以vbcrlf分割的内容

        If Len(tmp) > 0 Then    '空字符串跳过

            '如果前8个字符可以转换为日期

            If IsDate(Format(Left(tmp, 8), "####-##-##")) Then

                '取时间部分为结果数组的起始下标

                n = Mid(tmp, 9, 2) * 60     '按示例60个一组

            '下面这个判断是按示例做的，如果实际不同就自己找规律改

            ElseIf tmp Like "###### ######" Then

                arrResult(n) = Mid(tmp, InStr(tmp, Chr(32)) + 1)   '取空格后面的字符

                n = n + 1

            End If

        End If

        y = x + 1

        x = InStr(x + 1, sFile, vbCrLf)

    Loop

    

    '写入新文本

    hFile = FreeFile

    Open "E:\res.txt" For Output As hFile

        Print #hFile, Join(arrResult, vbCrLf)

    Close
贝隆 2010-03-24
  • 打赏
  • 举报
 回复
UPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUP
skylinecn 2010-03-24
  • 打赏
  • 举报
 回复
呵呵，没详测，你应该重复的是缺失的数据吧，我修改了一下，你再看看。对不起了。


Private Sub Command1_Click()

Dim ss$(), s1$(), s$, StrSS$, i&, j&, s2$, n&

ss = Split(Form1.RichTextBox1.Text, vbCrLf)

For i = 0 To UBound(ss)

    If InStr(ss(i), " 02 60") = InStrRev(ss(i), " 02 60") And InStr(ss(i), " 02 60") > 0 Then

        If 0 = InStr(s, ss(i)) Then

            If s2 = "" Then

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            Else

                n = DateDiff("h", s2, Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")) - 1

                If n > 0 Then

                    For i1 = 1 To n * 60

                        StrSS = StrSS & "999999" & vbCrLf

                    Next i1

                End If

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            End If

            s = s & ss(i) & vbCrLf

            i = i + 1

            For j = i To UBound(ss)

                If Len(ss(j)) > 7 Then

                    If InStr(ss(j), " 02 60") = InStrRev(ss(j), " 02 60") And InStr(ss(j), " 02 60") > 0 Then

                        i = j - 1: Exit For

                    Else

                        s1 = Split(ss(j), " ")

                        StrSS = StrSS & s1(1) & vbCrLf

                    End If

                End If

            Next j

        End If

    End If

Next i

MsgBox StrSS

End Sub
ajunajun 2010-03-24
  • 打赏
  • 举报
 回复
LZ问题补充：
d、文件中会重复1小时的数据，但重复的时间不确定，比如有时候会重复3点的数据或5点或7点……。
guyehanxinlei 2010-03-24
  • 打赏
  • 举报
 回复
友情帮顶
skylinecn 2010-03-24
  • 打赏
  • 举报
 回复
呵呵


Private Sub Command1_Click()

Dim ss$(), s1$(), s$, StrSS$, i&, j&, s2$, n&

ss = Split(Form1.RichTextBox1.Text, vbCrLf)

For i = 0 To UBound(ss)

    If InStr(ss(i), " 02 60") = InStrRev(ss(i), " 02 60") And InStr(ss(i), " 02 60") > 0 Then

        If 0 = InStr(s, ss(i)) Then

            If s2 = "" Then

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            Else

                n = DateDiff("h", s2, Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00"))

                If n > 1 Then

                    For i1 = 1 To n * 60

                        StrSS = StrSS & "999999" & vbCrLf

                    Next i1

                End If

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            End If

            s = s & ss(i) & vbCrLf

            i = i + 1

            For j = i To UBound(ss)

                If Len(ss(j)) > 7 Then

                    If InStr(ss(j), " 02 60") = InStrRev(ss(j), " 02 60") And InStr(ss(j), " 02 60") > 0 Then

                        i = j - 1: Exit For

                    Else

                        s1 = Split(ss(j), " ")

                        StrSS = StrSS & s1(1) & vbCrLf

                    End If

                End If

            Next j

        End If

    End If

Next i

MsgBox StrSS

End Sub
ajunajun 2010-03-24
  • 打赏
  • 举报
 回复
补充：
c、每缺1小时的数据，都要用60个“999999”代替，即输出文件中：“存在的数+缺测的数=24小时*60个/小时=1440个”
ajunajun 2010-03-24
  • 打赏
  • 举报
 回复
[Quote=引用 10 楼 skylinecn 的回复:]
200801010100 02 60我暂时不知道楼主的这个" 02 60"是不是固定的，我暂时当他是唯一，有问题楼主再提出来，我下面给个代码，楼主试试看。

一个Command1,一个RichTextBox1。需要筛选的文本放入RichTextBox1

VB code

Private Sub Command1_Click()
Dim ss$(), s1$(), s$, StrSS……
[/Quote]
非常感谢！！！
a、我这个是一天一个文件，一次只处理一天的就成。所以不用200801020100 02 60'超过第二天的空数据
b、" 02 60"是固定的
谢谢回复，我这就试试！！！
skylinecn 2010-03-24
  • 打赏
  • 举报
 回复
[Quote=引用 11 楼 bestbadgod 的回复:]
引用 10 楼 skylinecn 的回复:
200801010100 02 60我暂时不知道楼主的这个" 02 60"是不是固定的，我暂时当他是唯一，有问题楼主再提出来，我下面给个代码，楼主试试看。

一个Command1,一个RichTextBox1。需要筛选的文本放入RichTextBox1

VB code

Private Sub Command1_Click()
Dim……
[/Quote]
学习的机会
倒大霉的上帝 2010-03-24
  • 打赏
  • 举报
 回复
[Quote=引用 10 楼 skylinecn 的回复:]
200801010100 02 60我暂时不知道楼主的这个" 02 60"是不是固定的，我暂时当他是唯一，有问题楼主再提出来，我下面给个代码，楼主试试看。

一个Command1,一个RichTextBox1。需要筛选的文本放入RichTextBox1

VB code

Private Sub Command1_Click()
Dim ss$(), s1$(), s$, StrSS……
[/Quote]
娃娃真有耐心。
skylinecn 2010-03-24
  • 打赏
  • 举报
 回复
200801010100 02 60我暂时不知道楼主的这个" 02 60"是不是固定的，我暂时当他是唯一，有问题楼主再提出来，我下面给个代码，楼主试试看。

一个Command1,一个RichTextBox1。需要筛选的文本放入RichTextBox1


Private Sub Command1_Click()

Dim ss$(), s1$(), s$, StrSS$, i&, j&, s2$, n&

ss = Split(Form1.RichTextBox1.Text, vbCrLf)

For i = 0 To UBound(ss)

    If InStr(ss(i), " 02 60") = InStrRev(ss(i), " 02 60") And InStr(ss(i), " 02 60") > 0 Then

        If 0 = InStr(s, ss(i)) Then

            If s2 = "" Then

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            Else

                n = DateDiff("h", s2, Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00"))

                If n > 1 Then

                    For i1 = 1 To n

                        StrSS = StrSS & "999999" & vbCrLf

                    Next i1

                End If

                s2 = Format(Left(ss(i), 10) & "0101", "0000-00-00 00:00:00")

            End If

            s = s & ss(i) & vbCrLf

            i = i + 1

            For j = i To UBound(ss)

                If Len(ss(j)) > 7 Then

                    If InStr(ss(j), " 02 60") = InStrRev(ss(j), " 02 60") And InStr(ss(j), " 02 60") > 0 Then

                        i = j - 1: Exit For

                    Else

                        s1 = Split(ss(j), " ")

                        StrSS = StrSS & s1(1) & vbCrLf

                    End If

                End If

            Next j

        End If

    End If

Next i

MsgBox StrSS

End Sub


-----------------
我测试时用的文本：
200801010100 02 60
00 01
012395 029550
012390 029560

200801010100 02 60
00 01
012390 029550
012395 029545

200801010500 02 60'超过4个小时空数据
00 01
012390 029550
012395 029545

200801020100 02 60'超过第二天的空数据
00 01
012390 029550
012395 029545

-----------------
输出的结果：
029550
029560
999999
999999
999999
999999
029550
029545
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
999999
029550
029545
加载更多回复（9）
用Python处理文件
本课程主要结合Python的open函数、os包、pathlib包和shutil包介绍用Python处理文件的方法。 相关套餐： Python+VBA办公自动化系列课程-CSDN程序员研修院 讲师：童大谦 图书《代替VBA！用Python轻松实现Excel编程》和...
VB如何自动保存_VB小课堂初识VB
一直都说的新教材还是没下来于是这个学年还是继续VB教学其实VB这个编程软件真的很老了已经好多好多年没有更新过了但是VB语法都是比较规范的它又是一个面象对象的编程软件所以比较适合学习编程的初学者那今天我们就...
vb字符串选定复制代码
登录网页微信知乎图片视频医疗汉语问问更多»搜索答案我要提问首页问题分类特色问豆商城个人中心问题已被解决QQ一键登录IT技术vb 获取选中文字字数问题一，如题，选中文本框中一段文字，显示共有多少字符；...
vb/vb.net开发精粹(23)
编VB程序结合有道网页翻译找生词的尝试 请教字符串数据提取思路 ...请教高手指点迷津，如何读取一定格式的文本文件向Excel写入数据？ 如何让程序跳过启动时的一个对话框 VC代码转VB 如何更新col
ashx需要编译吗_Ashx文件为什么提示找不到网页，急！
在网上看到的资料希望对你有帮助，就是设置iis和web.config如果 ...这些资源包括 ASP.NET Web 页(.aspx 文件)、Web 服务(.asmx 文件)、ASP.NET 处理程序(.ashx 文件)和您已经映射到 ASP.NET 的任何文件类型。如果 A...
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章