在 Instr 为真并拆分后获取文本文件数据

Question

我附上了示例文本文件的副本。我有一个代码可以找到第一行的商店 ID 和日期（StoreID = 101190 和日期 = 112421）。在工作表的一个单元格中，我组合了 storeID 和 Date。我有下面的代码，我可以将它们放在一起，但这让我到了行尾。我想从日期单元格值到“99 END OF DAY”。我希望将第 12 行和第 13A 行分开，因为每个值代表一次付款。然后处理费线和安全检查线也被拆分。我该如何实施？任何帮助，将不胜感激。我将 google 驱动器 link 放入包含 3 个日期的文件示例。通常该文件包含几年前的所有数据，因此它是一个长文件。

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


sFile = "C:\Users\axela\Desktop\FileSample.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:\Users\Fane Branesti\Downloads\FileSample.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

在 Instr 为真并拆分后获取文本文件数据

Getting Text File data after Instr is true and splitting

excel

vba

text-files