Question

Sub ReadEntireFileAndPlaceOnWorksheet()
    Dim X As Long, Ys As Long, FileNum As Long, TotalFile As String, FileName As String, Result() As String, Lines() As String, rng As Range, i As Long, used As Range, lc As Long
    
         FileName = "C:\Users\MEA\Documents\ELCM2\DUMMY_FILE.dat"
        FileNum = FreeFile
         Open FileName For Binary As #FileNum
        TotalFile = Space(LOF(FileNum))
        Get #FileNum, , TotalFile
        Close #FileNum
        Lines = Split(TotalFile, vbNewLine)
         Ys = 1
         lc = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column
        For X = 1 To UBound(Lines)
            Ys = Ys + 1
            ReDim Preserve Result(1 To Ys)
            Result(Ys) = "'" & Lines(X - 1)
            Set used = Sheet1.Cells(Sheet1.Rows.Count, lc + 1).End(xlUp).Rows
            Set rng = used.Offset(1, 0)
            rng.Value = Result(Ys)
         Next
         
End Sub

我试图在.dat（二进制文件）中找到一些数据。数据应如下所示：

MiHo14.dat
MDF     3.00    TGT 15.0
Time: 06:40:29 PM
Recording Duration: 00:05:02
Database: DB
Experiment: Min Air take
Workspace: MINAIR
Devices: ETKC:1,ETKC:2
Program Description: 0delivupd2
Module_delivupd2
WP: _AWD_5
RP: _AWD
§@
Minimum intake - + revs - Downward gear

我目前从.dat文件中提取所有数据的代码和Excel文件中的位置如下所示：

MiHo14.dat
MDF     3.00    TGT 15.0
Time: 06:40:29 PM
Recording Duration: 00:05:02
Database: DB
Experiment: Min Air take
Workspace: MINAIR
Devices: ETKC:1,ETKC:2
Program Description: 0delivupd2
Module_delivupd2
WP: _AWD_5
RP: _AWD
§@
Minimum intake - + revs - Downward gear 
Bã|ŽA…@@,s~?
B{À¿…@@@Ý‚Iá 
Á<
"@²n¢”N@ÇÿÈÿj
Ð=“SØ•N@ÇÿÈÿj   
à¨. —N@ÇÿÈÿj
 8²œg˜N@ÇÿÈÿj
0NI,¯™N@ÈÿÈÿj
Ðä$öšN@ÈÿÈÿj
@Q›=œN@ÈÿÈÿj
ÐŸe…N@ÇÿÈÿj
 GàÍžN@ÇÿÈÿj"
etc....

我需要知道如何使用instr函数通过识别包含“：”的行来提取信息，另一个挑战是数据中的最后一行是用户注释，这个用户注释基本上可以是任何文本，我需要能够在不提取整个文件的情况下提取它，因为你可以看到它附带了很多符号（乱码）。

Answer 1

我认为您不想复制所有HD / PR / TX块以获得您想要的输出。

检查您的文件，我可以在有效数据和无效数据之间看到一个区别（从您的角度来看）无效数据不是以CR-LF组合结束，或者包含空字符。如果该特征在整个文件中保持一致，您可以使用它来获益：

以下是我使用的代码和结果。您可以修改自己例程的变量，看它是否一致。

Option Explicit
Sub ProcessDAT()
    Const sFN As String = "D:\Users\Ron\Desktop\DUMMY_FILE.dat"
    Const sEND As String = vbCrLf
    Dim S As String, COL As Collection, V As Variant, I As Long
    Dim R As Range

Open sFN For Binary Access Read As #1
S = Space(LOF(1))
    Get #1, , S
Close #1

V = Split(S, sEND)
Set COL = New Collection
For I = 0 To UBound(V)
    If InStr(V(I), Chr(0)) = 0 Then COL.Add V(I)
Next I

ReDim V(1 To COL.Count, 1 To 1)
For I = 1 To UBound(V)
    V(I, 1) = COL(I)
Next I

Set R = Range("a1").Resize(UBound(V))
R = V  
End Sub

结果

Time: 11:47:42 AM
Recording Duration: 00:01:09
Database: Testproject
Experiment: Measurement_Dummy
Workspace: Workspace
Devices: ETKC:1
Program Description: LPOOPL14
WP: LPOOPL14d2_1
RP: LPOOPL14d2
§@
Dummy test data

Answer 2

该代码无法编译，因为您还没有循环for循环。

Sub ReadEntireFileAndPlaceOnWorksheet()
    Dim X As Long, Y As Long, FileNum As Long, sFile As String, FileName As String, Result() As String, Lines() As String, rng As Range, i As Long, used As Range, MyFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        MyFolder = .SelectedItems(1)
    End With
    FileName = Dir(MyFolder & "\*.*")
    Do Until FileName = ""
        sFile = ReadFile(MyFolder & "\" & FileName)
        Lines = Split(sFile, vbLf)
        Y = 1
        For X = 1 To UBound(Lines)
            If InStr(1, Lines(X), ":", vbTextCompare) <> 0 Then
                ReDim Preserve Result(Y) '<-- Changed to a 1D array, I don't know why you had a 2D
                Result(Y) = "'" & Lines(X - 1)
                Y = Y + 1 '<-- increases to resize the array as it goes
            End If
        Next '<-- Added that in
        Set used = Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Columns
        Set rng = used.Offset(0, 1)
        rng.Resize(UBound(Result)).Formula = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Result))
        FileName = Dir()
    Loop
End Sub


Function ReadFile(ByVal strFile As String) As String
On Error GoTo Error_Handler
    Dim FileNumber  As Integer
    Dim sFile       As String 'Variable contain file content
    FileNumber = FreeFile
    Open strFile For Binary Access Read As FileNumber
    sFile = Space(LOF(FileNumber))
    Get #FileNumber, , sFile
    Close FileNumber

    ReadFile = sFile

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ReadFile" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

将您的数组更改为1维

最后，如果您正确缩进代码，可以更轻松地阅读和帮助您。

请在此处阅读文件：http://www.devhut.net/2012/05/14/vba-read-file-into-memory/

Answer 3

＆＃13;

Option Explicit
Sub ProcessDAT()
    Const sFN As String = "C:\Users\Mohamed samatar.DSSE-EMEA\Documents\EQVL\Test\WHVP113_140827_TTinsug_TTbana_292Data_WOT_TakeOff_Launch_LaunchPlus_PUoff_REF_1.dat"
    Const sEND As String = vbCrLf
    Dim S As String, COL As Collection, V As Variant, I As Long
    Dim R As Range
    Dim MLocation  As Long
    Dim PRLocation As Long
    Dim Mstuff As String
    Dim MSize As Long
    Dim MSize1 As Integer
      
Open sFN For Binary Access Read As #1
    Get #1, &H49, MLocation

    MSize = MLocation + 2
   
    Get #1, MSize, MSize1
    'MsgBox Hex(MSize1)
    
   
    Mstuff = String$(MSize1, " ")
    Get #1, MLocation, Mstuff
Close #1

V = Split(Mstuff, sEND)
Set COL = New Collection
For I = 0 To UBound(V)
    If InStr(V(I), Chr(0)) = 0 Then COL.Add V(I)
Next I

ReDim V(1 To COL.Count, 1 To 1)
For I = 1 To UBound(V)
    V(I, 1) = COL(I)
Next I

Set R = Range("a1").Resize(UBound(V))
R = V
End Sub

＆＃13;

我使用了Integer，因为它是一个2字节的数据类型，现在它可以工作了，你能评论一下这是你所说的解决方案吗？！

从二进制.dat文件中搜索特定的数据字符串，仅提取文本

3 个答案:

结果