从二进制 .dat 文件中搜索特定字符串的数据，仅提取文本
Search for specific strings of data from a binary .dat file, only extract text
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 函数通过识别包含“:”的行来提取信息，另一个挑战是数据中的最后一行是用户评论这个用户评论基本上可以是任何文本，我需要能够在不提取整个文件的情况下提取它，因为正如您所看到的那样，它带有很多符号（乱码）。
该代码无法编译，因为您还没有循环 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
将数组更改为一维
最后，如果您正确地缩进代码，它会更容易阅读并为您提供帮助。
此处感谢文件阅读：http://www.devhut.net/2012/05/14/vba-read-file-into-memory/
我认为您不想复制所有 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
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
我使用了 Integer，因为它是一个 2 字节的数据类型，现在它可以工作了，如果这就是您所说的解决方案，您能评论一下吗？！
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 函数通过识别包含“:”的行来提取信息，另一个挑战是数据中的最后一行是用户评论这个用户评论基本上可以是任何文本，我需要能够在不提取整个文件的情况下提取它，因为正如您所看到的那样，它带有很多符号（乱码）。
该代码无法编译，因为您还没有循环 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
将数组更改为一维
最后，如果您正确地缩进代码，它会更容易阅读并为您提供帮助。
此处感谢文件阅读：http://www.devhut.net/2012/05/14/vba-read-file-into-memory/
我认为您不想复制所有 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
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
我使用了 Integer，因为它是一个 2 字节的数据类型，现在它可以工作了，如果这就是您所说的解决方案，您能评论一下吗？！