在Instr之后获取文本文件数据是真的并且是分裂的

Question

我附加了一个示例文本文件的副本。我有一个代码，可以找到第一行的storeID和Date(storeID=101190，Date=112421(。在工作表的一个单元格中，我将storeID和Date组合在一起。我有下面的代码，我可以把它们放在一起，但这让我走到了最后。我希望从日期单元格值到"0"；99天结束"；。我想把第12行和第13A行分开，因为每个值代表一笔付款。然后，处置费线和安全检查线也要分开。我该如何实现？如有任何帮助，我们将不胜感激。我放了一个谷歌驱动器链接到一个包含3个日期的文件样本。通常，该文件包含几年前的所有数据，因此它是一个长文件。

Sub GetDailySales()
todaysdate = ThisWorkbook.Worksheets("Sheet1").Range("A2").Value
todaysdate2 = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value & Format(todaysdate, "mmddyy")

sFile = "C:UsersaxelaDesktopFileSample.txt"

Dim objFSO As Object
Dim objTextFile As Object
Dim lngCount As Long, i As Long
Dim FileNum As Integer
Dim DataLine As String
Dim strFound As String
Dim bFound As Boolean
Dim vLine As Variant
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(sFile, ForReading, -1)

Do While Not objTextFile.AtEndOfStream
lngCount = lngCount + 1    'increment a counter'
' read in data 1 line at a time'
DataLine = objTextFile.ReadLine
If InStr(1, DataLine, todaysdate2) > 0 Then    'the string is found'
bFound = True    'set a boolean value to true'
Exit Do    'and stop the loop'
End If
Loop

If bFound = True Then    'The text string was found'
'Read through the file line by line to the line after the found line'

For i = 1 To lngCount
Do While Not objTextFile.AtEndOfStream
strFound = objTextFile.ReadLine
strFound = Trim(strFound)
ThisWorkbook.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = strFound
Loop
Next i

objTextFile.Close    'close the file'
Set objFSO = Nothing
Set objTextFile = Nothing
Else    'The text was not found'
FileSearch = "Not found" 'tell the user'
End If
Exit Sub
End Sub

所需结果：以12和13a开头的行将每个数值拆分为

12 1707.97152211    142.16     73.54    299.67   1071.52     73.54      0.00      0.0017:01     47.54      0.00      0.00      0.00      0.00      0.00X1      0.00      0.00
13A    0.00    0.00    0.00    0.00   6  26    0.00   1687.69   1729.69   97.35    0.00    0.00   75.63    0.00   0  12  20  26   1687.69
SAFETY INSPECTION 63.00 9
DISPOSAL FEE 65.00 26

如果不可能，那么只需将数据放入工作表中，我将使用powerquery来处理其余的数据。我只是在从StoreID和Date到99 END OF DAY获取数据时遇到问题。我需要每天由它自己根据表格单元格的值。

Answer 1

请尝试下一个代码：

Sub extractDatafromTextFile()
Dim sh As Worksheet, txtFileName As String, lastR As Long, i As Long, j As Long
Dim arrTxt, arrPay1, arrPay2, arrSI, arrDF, SI As Long, val1 As Double
Const todaysdate2 As String = "101190112421" 'take it from your worksheet

Set sh = 'ThisWorkbook.Worksheets("Sheet1")
txtFileName = "C:UsersFane BranestiDownloadsFileSample.txt"
arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(txtFileName, 1).ReadAll, vbCrLf)

For i = 0 To UBound(arrTxt)
If InStr(arrTxt(i), todaysdate2) > 0 Then
Do While InStr(arrTxt(i + j), "END OF DAY") = 0
j = j + 1
If left(arrTxt(i + j), 3) = "12 " Then
arrPay1 = Split(WorksheetFunction.Trim(arrTxt(i + j)), " ")
End If
If left(arrTxt(i + j), 4) = "13A " Then
arrPay2 = Split(WorksheetFunction.Trim(arrTxt(i + j)), " ")
End If
If InStr(arrTxt(i + j), "SAFETY INSPECTION") > 0 Then
SI = InStr(arrTxt(i + j), "SAFETY INSPECTION")
arrSI = Split(WorksheetFunction.Trim(left(arrTxt(i + j), SI - 1)), " ")
val1 = arrSI(1):
arrSI(0) = "SAFETY INSPECTION": arrSI(1) = arrSI(2): arrSI(2) = val1
End If
If InStr(arrTxt(i + j), "DISPOSAL FEE") > 0 Then
SI = InStr(arrTxt(i + j), "DISPOSAL FEE")
arrDF = Split(WorksheetFunction.Trim(left(arrTxt(i + j), SI - 1)), " ")
val1 = arrDF(1):
arrDF(0) = "DISPOSAL FEE": arrDF(1) = arrDF(2): arrDF(2) = val1
End If
Loop
End If
Next i
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
sh.Range("A" & lastR + 1).Resize(1, UBound(arrPay1) + 1).value = arrPay1
sh.Range("A" & lastR + 2).Resize(1, UBound(arrPay2) + 1).value = arrPay2
sh.Range("A" & lastR + 3).Resize(1, UBound(arrSI) + 1).value = arrSI
sh.Range("A" & lastR + 4).Resize(1, UBound(arrDF) + 1).value = arrDF
MsgBox "Ready..."
End Sub