GSerg писал(а):Потому что, наверное, понятие User Defined Types нам не знакомо?
batiq писал(а):VS0000AD075L7055EEWSDACTADPHM00009340A0 505-02-1005-02-10
Private Type DATA_STRUCTURE
RecordName As String * 2
TlcoCon As String * 4
ExchangeID As String * 11
SystemName As String * 4
MeasurementName As String * 8
JobNum As String * 8
VersionN As String * 4
BeginDate As String * 8
EndDate As String * 8
End Type
Dim mtVar4Read As DATA_STRUCTURE
Sedge писал(а):
- Код: Выделить всё
..
Dim mtVar4Read As DATA_STRUCTURE
Private Type DATA_STRUCTURE
RecordName As String * 2
TlcoCon As String * 4
ExchangeID As String * 11
SystemName As String * 4
MeasurementName As String * 8
JobNum As String * 8
VersionN As String * 4
BeginDate As String * 8
EndDate As String * 8
End Type
Sub ReadTGRP()
Dim mtVar4Read As DATA_STRUCTURE
Dim FileNum As Integer
Dim txt As String
Dim i As Integer
FileNum = FreeFile
i = 0
fileToOpen = Application.GetOpenFileName("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
Open fileToOpen For Input As FileNum
Worksheets("Ëèñò1").Activate
Cells.Select
Cells.Clear
Input #FileNum, mtVar4Read.RecordName, mtVar4Read.TlcoCon, mtVar4Read.ExchangeID, _
mtVar4Read.SystemName, mtVar4Read.MeasurementName, mtVar4Read.JobNum, _
mtVar4Read.VersionN, mtVar4Read.BeginDate, mtVar4Read.EndDate
Do Until EOF(FileNum)
Line Input #FileNum, txt
Worksheets("Ëèñò1").Activate
i = i + 1
Range("A" + CStr(i)).Select
ActiveCell = txt
Loop
Close #FileNum
End If
End Sub
alibek писал(а):Open For Random As ... Len = Len(mtVar4Read)
Input #FileNum, mtVar4Read
alibek писал(а):Ты открываешь файл не для последовательного ввода/вывода..
alibek писал(а):Открывай, как Binary и пиши свой обработчик или класс.
Function ReadData(ByVal File As String, ByVal LineNumber As Long, ByRef Arguments() As String) As Boolean
Dim FN As Integer, C As Long, L As String
FN = FreeFile()
Open File For Input As #FN
Do While Not EOF(FN)
Line Input #FN, L
C = C + 1
If C = LineNumber Then
Select Case C
Case 1
Call Process1Line(L, Arguments)
Case 2
Call Process2Line(L, Arguments)
Case Else
Call ProcessRestLine(L, Arguments)
End Select
Exit Function
End If
Loop
Close #FN
End Function
Sub Process1Line(ByVal LineString As String, Args() As String)
' 1 2 3 4 5
'123456789012345678901234567890123456789012345678901234567
'* * * * * * * * *
'VS0000AD075L7055EEWSDRECTGRP 00002529G03905-02-1005-02-10
'
Dim I As Long
ReDim Args(1 To 9)
Args(1) = Mid$(LineString, 1, 2)
Args(2) = Mid$(LineString, 3, 4)
Args(3) = Mid$(LineString, 7, 11)
Args(4) = Mid$(LineString, 18, 4)
Args(5) = Mid$(LineString, 22, 8)
Args(6) = Mid$(LineString, 30, 8)
Args(7) = Mid$(LineString, 38, 4)
Args(8) = Mid$(LineString, 42, 8)
Args(9) = Mid$(LineString, 50, 8)
End Sub
Sub Process2Line(ByVal LineString As String, Args() As String)
' 1 2 3 4 5 6 7 8 9 10 11 12
'1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901
'* * * * * ** * * * *
2529 291G039 151D900 05-02-1000-00-0000-00-0000-00-0005-02-1000-00-00-0000-00-00-0000-00-00-0000-00-00-00000000TS.TGRP.TH1
'
Dim I As Long
ReDim Args(1 To 11)
Args(1) = Mid$(LineString, 1, 4)
Args(2) = Mid$(LineString, 5, 3)
Args(3) = Mid$(LineString, 8, 2)
Args(4) = Mid$(LineString, 10, 3)
Args(5) = Mid$(LineString, 13, 2)
Args(6) = Mid$(LineString, 15, 1)
Args(7) = Mid$(LineString, 16, 5)
Args(8) = Mid$(LineString, 21, 8)
Args(9) = Mid$(LineString, 29, 24)
Args(10) = Mid$(LineString, 53, 58)
Args(11) = Mid$(LineString, 111, 11)
End Sub
Sub ProcessRestLine(ByVal LineString As String, Args() As String)
' Здесь будет код, аналогичный предыдущим двум, только позиции столбцов другие.
End Sub
Dim A() As String
If ReadData("c:\file1", 4, A()) Then
' строка найдена, параметры в массиве A()
End If
Сейчас этот форум просматривают: AhrefsBot и гости: 60