Question

我需要从目录中的所有.txt文件中提取数据（'TOTAL TRAVEL（ALLOWANCES＆amp; AIRFARES＆amp; Car Hire）'，也就是sMarker5），我的当前代码的工作量小于1000美元的生产线。我猜这是因为对这行的＆gt; $ 1,000的文件总是在回车后。所以我的问题是......我应该如何修改我的代码以使其适用于任何金额？

我的下一个问题是......我还需要提取“租车”的数据，但是，“租车”这个词在我实际想要的那个之前出现了不同的时间（不是常数T_T）（'租车$' ＃。##'，位于.txt文件末尾附近... ...有没有办法用我的代码实现这个目标？

提前感谢大家!!!

Sub AddTrs2()

'Another sub
ClearAll

Dim MyFolder As String
MyFolder = "Z:\fin1\data\FIN118P\import\Travel\TRs\"
Sep = Application.PathSeparator

If Sep = "\" Then
    F = Dir(MyFolder & Sep & "*.txt")
End If

Range("A2").Select

Do While Len(F) > 0
    ActiveCell.Formula = MyFolder & F
    ActiveCell.Offset(1, 0).Select
    noLines = noLines + 1
    F = Dir()
Loop

Range("A2").Select

GrabData
'Invoke the sub "GrabData"

End Sub

Sub GrabData()

Const sMarker1 = "Total Accommodation"
Const sMarker2 = "INCIDENTAL ALLOWANCE"
Const sMarker3 = "TA & EXCESS COSTS"
Const sMarker4 = "Travel Tax"
Const sMarker5 = "TOTAL TRAVEL (ALLOWANCES & AIRFARES & Car Hire)"
Const sMarker6 = "Non ACMA Traveller Name:"
Const sMarker7 = "Excess Costs "

Dim text As String
Dim textline As String
Dim TrvReqs As Long
Dim Incidental As Long
Dim TotalAccom As Long
Dim TAExcess As Long
Dim TravelTax As Long
Dim TOTALTRAVEL As Long
Dim NonACMA As String
Dim ExcessCosts As Long
Dim i As Long, oRng As Range

Set oRng = Range("A1")
For i = 1 To noLines
    text = ""
    'Reset the text to blank

    Open oRng.Offset(i, 0).Value For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop

    Close #1

    'Get location of text after sMarker
    TotalAccom = InStr(text, sMarker1) + Len(sMarker1) + 2
    Incidental = InStr(text, sMarker2) + Len(sMarker2) + 2
    TAExcess = InStr(text, sMarker3) + Len(sMarker3) + 2
    TravelTax = InStr(text, sMarker4) + Len(sMarker4) + 2
    TOTALTRAVEL = InStr(text, sMarker5) + Len(sMarker5) + 2
    TrvReqs = Left(Right(oRng.Offset(i, 0).Value, 10), 6)
    NonACMA = InStr(text, sMarker6) + Len(sMarker6)
    ExcessCosts = InStr(text, sMarker7) + Len(sMarker7) + 2

    'Store 6 characters of text after sMarker to Columns
    oRng.Offset(i, 1).Value = TrvReqs
    oRng.Offset(i, 2).Value = Mid(text, TotalAccom, 6)
    oRng.Offset(i, 3).Value = Mid(text, Incidental, 6)
    oRng.Offset(i, 5).Value = Mid(text, TAExcess, 6)
    oRng.Offset(i, 6).Value = Mid(text, TravelTax, 6)
    oRng.Offset(i, 7).Value = Mid(text, TOTALTRAVEL, 6)
    oRng.Offset(i, 8).Value = Mid(text, ExcessCosts, 100)
    oRng.Offset(i, 11).Value = Mid(text, NonACMA, 30)
Next i
Set oRng = Nothing

'Another sub
ClearNonNumeric

Range("A1").Select

End Sub

更新：

我试图将David的代码应用于另一个问题：捕获“TOTAL TRAVEL（ALLOWANCES＆amp; AIRFARES＆amp; Car Hire）”这一行，它有时在返回后有美元价值（参见上面的代码，它适用于没有回报 - 即美元金额低于1,000美元）。但是，在我用David的建议修改代码之后...我得到一个运行时错误'5'：针对TOTALTRAVEL = InStrRev（text，sMarker5，endParse）的无效过程调用或参数 ）行......

我不确定我做错了什么......

Sub GrabData()

Const sMarker1 = "Total Accommodation"
Const sMarker2 = "INCIDENTAL ALLOWANCE"
Const sMarker3 = "TA & EXCESS COSTS"
Const sMarker4 = "Travel Tax"

'New line
Const sMarker5 As String = "TOTAL TRAVEL (ALLOWANCES & AIRFARES & Car Hire)"

Const sMarker6 = "Non ACMA Traveller Name:"
Const sMarker7 = "Excess Costs "
Const sMarker8 = "Car Hire "

'New line
Const sTerminate As String = "AccommodationNightsPrice/NightTotal"

Dim text As String
Dim textline As String
Dim TrvReqs As Long
Dim Incidental As Long
Dim TotalAccom As Long
Dim TAExcess As Long
Dim TravelTax As Long
Dim TOTALTRAVEL As Long
Dim NonACMA As String
Dim ExcessCosts As Long
Dim CarHire As Long

'New line
Dim endParse As Long

Dim i As Long, oRng As Range

'New line
endParse = InStr(1, text, sTerminate)

Set oRng = Range("A1")
For i = 1 To noLines
    text = ""
    Open oRng.Offset(i, 0).Value For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop

    Close #1

    TotalAccom = InStr(text, sMarker1) + Len(sMarker1) + 2
    Incidental = InStr(text, sMarker2) + Len(sMarker2) + 2
    TAExcess = InStr(text, sMarker3) + Len(sMarker3) + 2
    TravelTax = InStr(text, sMarker4) + Len(sMarker4) + 2

    'New line        
    TOTALTRAVEL = InStrRev(text, sMarker5, endParse)

    TrvReqs = Left(Right(oRng.Offset(i, 0).Value, 10), 6)
    NonACMA = InStr(text, sMarker6) + Len(sMarker6)
    ExcessCosts = InStr(text, sMarker7) + Len(sMarker7) + 2
    CarHire = InStrRev(text, sMarker8) + Len(sMarker8)

    oRng.Offset(i, 1).Value = TrvReqs
    oRng.Offset(i, 2).Value = Mid(text, TotalAccom, 6)
    oRng.Offset(i, 3).Value = Mid(text, Incidental, 6)
    oRng.Offset(i, 4).Value = Mid(text, CarHire, 7)
    oRng.Offset(i, 5).Value = Mid(text, TAExcess, 6)
    oRng.Offset(i, 6).Value = Mid(text, TravelTax, 6)

    'New line
     oRng.Offset(i, 7).Value = Replace(Trim(Mid(text, TOTALTRAVEL, (endParse - TOTALTRAVEL))sMarker5, vbNullString))

    oRng.Offset(i, 8).Value = Mid(text, ExcessCosts, 100)
    oRng.Offset(i, 11).Value = Mid(text, NonACMA, 30)
Next i
Set oRng = Nothing

ClearNonNumeric

Range("A1").Select

End Sub

Answer 1

我认为你需要倒数第二次出现的汽车租赁。

试试这个：

在GrabData例程中添加一些新常量。

Const sMarker8 As String = "Car Hire"
'This is what comes AFTER "Car Hire". It only appears once in the example file
Const sTerminate As String = "PDTA (Payable via salary)"

然后，您可以使用这两个字符串计算租车的位置：

'Find out what comes AFTER "Car Hire"
endParse = InStr(1, text, sTerminate)
'Now, work backwards from that position to find the first instance of "Car Hire" 
' that appears *before* the sTerminate string.
CarHire = InStrRev(text, sMarker8, endParse)

然后，使用Mid和Replace，您可以拉出租车的数字部分：

oRng.Offset(1, 12).Value = Replace( _
        Trim(Mid(text, CarHire, endParse - CarHire), sMarker8, vbNullString))

在示例文件中，返回$ 0.00

我认为即使美元金额由回车分隔，这也应该有效。

回车链接.txt文件 - VBA宏

1 个答案: