我附上了一份示例文本檔案的副本。我有一個代碼可以找到第一行的 storeID 和 Date（StoreID = 101190，Date is = 112421）。在作業表上的一個單元格中，我將 storeID 和 Date 組合在一起。我有下面的代碼，我可以把它放在一起，但這讓我走到了行尾。我想從日期單元格值到“99 END OF DAY”。我希望第 12 行和第 13A 行被拆分，因為每個值都代表一筆付款。然后將處置費用行和安全檢查行也分開。我該如何實施？任何幫助，將不勝感激。我將谷歌驅動器鏈接放在包含 3 個日期的檔案示例中。通常該檔案包含幾年前的所有資料，因此它是一個長檔案。
Sub GetDailySalesFromAutoData()
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 時遇到問題。我每天都需要根據作業表單元格值自行決定。
uj5u.com熱心網友回復：
請嘗試下一個代碼：
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/368736.html
上一篇：如何使用TensorFlow保存編碼器-解碼器模型？
下一篇：VBA測驗陣列中的值