Данные из текстового файла
Sub DataFromTextFile()
' Text File Address
Const strFile = "C:\Test1.txt"
Const cCriteria As Long = 67 ' Criteria Position
Const cPosition As Long = 38 ' Target Position
Const cChars As Long = 5 ' Target Chars
' Criteria Array
Dim vntC As Variant: vntC = Array("auto", "van")
' Row Array
Dim vntFR As Variant: vntFR = Array(6, 6)
' Column Array
Dim vntCC As Variant: vntCC = Array(2, 3)
Dim vntL As Variant ' Criteria Length Array
Dim vntR As Variant ' Target Row Counter Array
Dim LB As Long ' Array Lower Bound
Dim UB As Long ' Array Upper Bound
Dim i As Long ' Array Element Counter
Dim t As Long ' Total Records Counter
Dim lngFile As Long ' Text File Number
Dim strLine As String ' Current Line (in Text File)
' Calculate Lower and Upper Bounds.
LB = LBound(vntC): UB = UBound(vntC)
' Resize Criteria Length Array to the size of Criteria Array.
ReDim vntL(UB) As Long
' Calulate the length of each element in Criteria Array and write
' the calculated values to Criteria Length Array.
For i = LB To UB: vntL(i) = Len(vntC(i)): Next i
' Resize Target Row Counter Array to the size of Criteria Array.
ReDim vntR(UB) As Long
' Aquire Text File Number.
lngFile = FreeFile() '
' Write Text File to memory.
Open strFile For Input As #lngFile
' Loop through lines of Text File.
Do While Not EOF(lngFile)
' Write current line of Text File (from memory) to Current Line.
Line Input #lngFile, strLine
' Loop through elements of Arrays.
For i = LB To UB
' Check if Current Criteria is found at current Target Position.
If Mid(strLine, cCriteria, vntL(i)) = vntC(i) Then
' Count Target Row by increasing the current value
' of the current element in Target Row Counter Array.
vntR(i) = vntR(i) + 1
' Write Current Target Value to ActiveSheet.
Cells(vntFR(i) + vntR(i) - 1, vntCC(i)) _
= Trim(Mid(strLine, cPosition, cChars))
' Count Total (All) Records so far.
t = t + 1
Exit For
End If
Next i
Loop
Close #1
MsgBox "Total Records Found: " & t, vbInformation
End Sub
Все эти массивы не для скорости, а для возможности легко изменять значения переменных или, что более важно, добавлять дополнительные значения критериев, например:
' Criteria Array
Dim vntC As Variant: vntC = Array("auto", "van", "bike", "plane")
' Row Array
Dim vntFR As Variant: vntFR = Array(6, 6, 6, 6)
' Column Array
Dim vntCC As Variant: vntCC = Array(2, 3, 4, 5)
РЕДАКТИРОВАТЬ
Эта версия состоит из DataFromText, где вы изменяете имена текстовых файлов и пар столбцов соответственно, и НОВОЙ версии DataFromTextFile, где я уже изменил номера строк на 89 как просил. Лучше всего переименовать или удалить старую версию DataFromTextFile.
Option Explicit
Sub DataFromText()
Dim vntFiles As Variant ' Files Array
Dim i As Long ' Arrays Elements Counter
' Files
vntFiles = Array("C:\Test1.txt", "C:\Test2.txt", "C:\Test3.txt")
' If you add more files, you have to add more column pairs and increase
' the ubound of vntColumns i.e. the number in braces.
Dim vntColumns(2) As Variant
' Column Pairs
vntColumns(0) = Array(2, 8)
vntColumns(1) = Array(3, 9)
vntColumns(2) = Array(4, 10)
For i = 0 To UBound(vntFiles)
DataFromTextFile CStr(vntFiles(i)), vntColumns(i)
Next i
End Sub
Sub DataFromTextFile(FilePath As String, TargetColumns As Variant)
' Text File Address
Dim strFile As String
strFile = FilePath
Const cCriteria As Long = 67 ' Criteria Position
Const cPosition As Long = 38 ' Target Position
Const cChars As Long = 5 ' Target Chars
' Criteria Array
Dim vntC As Variant: vntC = Array("auto", "van")
' Row Array
Dim vntFR As Variant: vntFR = Array(89, 89)
' Column Array
Dim vntCC As Variant: vntCC = TargetColumns
Dim vntL As Variant ' Criteria Length Array
Dim vntR As Variant ' Target Row Counter Array
Dim LB As Long ' Array Lower Bound
Dim UB As Long ' Array Upper Bound
Dim i As Long ' Array Element Counter
Dim t As Long ' Total Records Counter
Dim lngFile As Long ' Text File Number
Dim strLine As String ' Current Line (in Text File)
' Calculate Lower and Upper Bounds.
LB = LBound(vntC): UB = UBound(vntC)
' Resize Criteria Length Array to the size of Criteria Array.
ReDim vntL(UB) As Long
' Calulate the length of each element in Criteria Array and write
' the calculated values to Criteria Length Array.
For i = LB To UB: vntL(i) = Len(vntC(i)): Next i
' Resize Target Row Counter Array to the size of Criteria Array.
ReDim vntR(UB) As Long
' Aquire Text File Number.
lngFile = FreeFile() '
' Write Text File to memory.
Open strFile For Input As #lngFile
' Loop through lines of Text File.
Do While Not EOF(lngFile)
' Write current line of Text File (from memory) to Current Line.
Line Input #lngFile, strLine
' Loop through elements of Arrays.
For i = LB To UB
' Check if Current Criteria is found at current Target Position.
If Mid(strLine, cCriteria, vntL(i)) = vntC(i) Then
' Count Target Row by increasing the current value
' of the current element in Target Row Counter Array.
vntR(i) = vntR(i) + 1
' Write Current Target Value to ActiveSheet.
Cells(vntFR(i) + vntR(i) - 1, vntCC(i)) _
= Trim(Mid(strLine, cPosition, cChars))
' Count Total (All) Records so far.
t = t + 1
Exit For
End If
Next i
Loop
Close #1
MsgBox "Total Records Found: " & t, vbInformation
End Sub