VB 从文件里提取部分数据

Question

我想从一个文件里提取部分数据，然后将它追加到另一个文本文件的后面欲提取文件内容如下：
200809050000   02  01     下划线字体为日期+时+分
00     01     
012365 018695 
200809050100   02  01
00     01     
012365 018650 
200809050200   02  01
00     01     
012365 018625 
200809050300   02  01
00     01     
012365 018670 
200809050400   02  01
00     01     
012365 018815 
200809050500   02  01
00     01     
012365 018960 
200809050600   02  01
00     01     
012365 019115 
200809050700   02  01
00     01     
012365 019270 
200809050700   02  01
00     01     
012365 019270 
200809050800   02  01
00     01     
012365 019315 
……
这些数据是一天的小时值数据，正常情况共24个，有时候会缺部分数据，缺数时用xxxxx代替
红色字体为要提取的小时值数据，其中每天会重复一个小时，例如上面文件重复的是蓝色字体7点的只提取其中的一个就行了提取后，追加到下面文件内容之后（以行的形式）：
（日期）20080902 （数据->）720  825  880  915  905  920  1030  1120  1170  1260  1280  1285  1240  1175  1090  1000  xxxxx  765  700  575  560  525  625  xxxxx 
20080903 840  930  1045  1100  1090  1070  1065  1060  1030  1020  985  900  665 -185 -375 -65 -15 -25 -75 -205 -310 -265 -160  5 
20080904 150  340  515  665  710  705  755  785  800  795  775  750  730  710  725  695  680  590  540  365  260  245  310  440 呵呵，比较麻烦，希望诸位仁兄帮帮忙啊！！！多谢！！

Answer 1

Private Type struct
    d As String
    h As Integer
    p As Long
End TypePrivate Type struct_show
    d As String
    s(23) As String
End TypePrivate Sub Command1_Click()
    Dim show() As struct_show
    Dim bytes() As Byte
    Dim i&, j&, lCount&, lSize&, hFile&
   
    lSize = FileLen("c:\1.txt")
    ReDim bytes(lSize) As Byte
    
    hFile = FreeFile
    Open "c:\1.txt" For Binary As hFile
    Get hFile, , bytes
    Close hFile
    
    lCount = Parser(StrConv(bytes, vbUnicode), show)
    
    Dim strShow As String
    For i = 0 To lCount
        strShow = show(i).d & " "
        For j = 0 To 23
            strShow = strShow & IIf(show(i).s(j) = vbNullString, "XXXXXX", show(i).s(j)) & " "
        Next
        Debug.Print strShow
    Next
    
End SubPrivate Function Parser(ByVal strData As String, show() As struct_show) As Long
    Dim i As Long
    Dim j As Long
    Dim lCount As Long
    
    Dim arr() As String
    Dim arrl() As String
    
    arr = Split(strData, vbCrLf)
    lCount = UBound(arr)
    
    ReDim data(lCount / 3) As struct
    For i = 0 To lCount
        If i Mod 3 = 0 Then
            arrl = Split(arr(i), " ")
            data(j).d = Left$(arrl(0), 8)
            data(j).h = Right$(arrl(0), 4) / 100
            j = j + 1
        ElseIf i Mod 3 = 2 Then
            arrl = Split(arr(i), " ")
            data(j).p = arrl(1)
        End If
    Next
    
    j = 0
    ReDim show(0) As struct_show
    show(0).d = data(0).d
    For i = 0 To lCount / 3
        If data(i).d <> show(j).d And data(i).d <> vbNullString Then
            j = j + 1
            ReDim Preserve show(j) As struct_show
            show(j).d = data(i).d
        End If
        show(j).s(data(i).h) = data(i).p
    Next
    Parser = j
End Function

Answer 2

上一个有些bug 下面是修正后的Option Explicit
Option Base 0Private Type struct
    d As String
    h As Integer
    p As Long
End TypePrivate Type struct_show
    d As String
    s(23) As String
End TypePrivate Sub Command1_Click()
    Dim show() As struct_show
    Dim bytes() As Byte
    Dim i&, j&, lCount&, lSize&, hFile&
   
    lSize = FileLen("c:\1.txt")
    ReDim bytes(lSize) As Byte
    
    hFile = FreeFile
    Open "c:\1.txt" For Binary As hFile
    Get hFile, , bytes
    Close hFile
    
    lCount = Parser(StrConv(bytes, vbUnicode), show)
    
    Dim strShow As String
    For i = 0 To lCount
        strShow = show(i).d & " "
        For j = 0 To 23
            strShow = strShow & IIf(show(i).s(j) = vbNullString, "XXXXXX", show(i).s(j)) & " "
        Next
        Debug.Print strShow
    Next
    
End SubPrivate Function Parser(ByVal strData As String, show() As struct_show) As Long
    Dim i As Long
    Dim j As Long
    Dim lCount As Long
    
    Dim arr() As String
    Dim arrl() As String
    
    arr = Split(strData, vbCrLf)
    lCount = UBound(arr)
    
    ReDim data(lCount / 3) As struct
    For i = 0 To lCount
        If i Mod 3 = 0 Then
            j = j + IIf(i = 0, 0, 1)  '
            arrl = Split(arr(i), " ")
            data(j).d = Left$(arrl(0), 8)
            data(j).h = Right$(arrl(0), 4) / 100
        ElseIf i Mod 3 = 2 Then
            arrl = Split(arr(i), " ")
            data(j).p = arrl(1)
        End If
    Next
    
    j = 0
    ReDim show(0) As struct_show
    show(0).d = data(0).d
    For i = 0 To lCount / 3
        If data(i).d <> show(j).d And data(i).d <> vbNullString Then
            j = j + 1
            ReDim Preserve show(j) As struct_show
            show(j).d = data(i).d
        End If
        If data(i).d <> vbNullString Then
            show(j).s(data(i).h) = data(i).p
        End If
    Next
    Parser = j
End Function

Answer 3

问题补充：1.经常还有这种问题，缺最后几个小时的数据，原文件不管缺多少输出文件里也要凑够24个数据，每缺一个补xxxxx

Answer 4

Data(j).h = Right$(arrl(0), 4) / 100  类型不匹配？？？

Answer 5

Data(j).h = Right$(arrl(0), 4) / 100  类型不匹配？？？

Answer 6

VB 直接支持固格式文本的读写
Private Sub FillHours(ByVal hFileDst As Integer, ByVal StartHour As Long, ByVal EndHour As Long)
    Dim i As Long    For i = StartHour To EndHour
        Print #hFileDst, " xxxxx ";
    Next
    If EndHour = 23 Then Print #hFileDst, ""
End SubPrivate Sub Command1_Click()
    Dim hFileSrc As Integer, hFileDst As Integer
    Dim a As Currency, b As Long, c As Long
    Dim lLastDate As Long, lLastHour As Long
    Dim lThisDate As Long, lThisHour As Long
    
    hFileSrc = FreeFile
    Open "c:\temp\1.txt" For Input As hFileSrc
    hFileDst = FreeFile
    Open "C:\temp\2.txt" For Append As hFileDst
    
    While Not EOF(hFileSrc)
        Input #hFileSrc, a, b, c
        Input #hFileSrc, b, c
        Input #hFileSrc, b, c
    
        lThisDate = Int(a / 10000)
        lThisHour = Int(a / 100) Mod 100
        
        If lThisDate <> lLastDate Then
            If lLastDate <> 0 Then
                FillHours hFileDst, lLastHour + 1, 23
            End If
            
            Print #hFileDst, lThisDate;
            
            lLastHour = -1
            lLastDate = lThisDate
        End If
        If lThisHour <> lLastHour Then
            FillHours hFileDst, lLastHour + 1, lThisHour - 1
            Print #hFileDst, c;
            
            lLastHour = lThisHour
        End If
    Wend
    Close #hFileSrc
    
    If lLastDate <> 0 Then
        FillHours hFileDst, lLastHour + 1, 23
    End If
    Close #hFileDst
End Sub

Answer 7

Tiger_Zhao这个方法好，可是日期前面有个空格怎么去除？？？？ 

Answer 8

转换成字符串输出就可以自己控制格式
Print #hFileDst, CStr(lThisDate);

Answer 9

还有问题啊？？？
输出文件有的是两个空格有的是一个，我想让每个数据间都是一个空格20080903 840 xxxxx 1045  1100  1090  1070  1065  1060  1030  1020  985  900  665 -185 -375 -65 -15 -25 -75 -205 -310 -265 -160 5 

Answer 10

14楼已经给了方法了。
变量 C 的输出用 CStr(C) 转成字符串，加上合适的空格。

Answer 11

Print #hFileDst, CStr(lThisDate); 主要是这个分号的问题吧？？？？

Answer 12

分号用来控制不换行，于空格无关。
还有我在 xxxxx 两边都留了空格，自己决定需要哪边的。