[英]EXCEL-VBA Return highest value from a find function from a txt file VBA
這是問題所在:
-我有一個包含大量數據的文本文件,但我必須提取包含字符串“ pressure:(values)”的行 。 該文件包含很多此字符串,我想在單詞pressure之后提取最高值。 以下是文件中的一些示例內容:-壓力:101.011-壓力:20.1102-壓力:20.1020
“壓力:”的出現次數不是固定的。
我已經找到一些實現此目的所需的功能(只需復制並編輯一些在網上找到的腳本)。 但是我不知道如何存儲匹配的值(也許存儲在數組中?)然后應用max函數返回最大值。 將不勝感激任何輸入。
也歡迎實現期望任務的其他方法。
這是我的腳本:
Sub search()
Const ForReading = 1
Dim FSO, FileIn, strTmp
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileIn = FSO.OpenTextFile("D:\data.txt", ForReading)
Do Until FileIn.AtEndOfStream
strTmp = FileIn.ReadLine
If Len(strTmp) > 0 Then 'read if not blank
If InStr(1, strTmp, "pressure:", vbTextCompare) > 0 Then 'find function
x = Mid(strTmp, 10, 7) 'to extract the numeric values only
MsgBox x 'just for checking if value of x is correct
'add function that will return the highest value
'WorksheetFunction.Max (x)
End If
End If
Loop
FileIn.Close
End Sub
如果您只想要單個最大壓力值,則只需跟蹤到目前為止找到的最大值,並在找到更大的值時對其進行更新。
這是您的代碼重構,並解決了其他一些小問題(標記為<---
更改)
Sub search()
Const ForReading = 1
'<--- Use specific data types rather than variant
Dim FSO As Object
Dim FileIn As Object
Dim strTmp As String
Dim KeyWord As String
Dim i As Long, j As Long
Dim x As Double
Dim MaxX As Double
MaxX = -4.94065645841247E-324 '<-- initialise to lowest possible value
KeyWord = "pressure:" ' <--- generalise the function
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileIn = FSO.OpenTextFile("D:\data.txt", ForReading)
Do Until FileIn.AtEndOfStream
strTmp = FileIn.ReadLine
If Len(strTmp) > 0 Then 'read if not blank
i = InStr(1, strTmp, KeyWord, vbTextCompare)
If i Then 'find function
' <-- cope with possibility Pressure is not at start of string
' and may have trailing data
strTmp = Trim$(Mid$(strTmp, i + Len(KeyWord)))
i = InStr(strTmp, " ")
If i Then
strTmp = Trim$(Left$(strTmp, i - 1))
End If
x = Val(strTmp) 'to extract the numeric values only
MsgBox x 'just for checking if value of x is correct
'add function that will return the highest value
If x > MaxX Then MaxX = x
End If
End If
Loop
FileIn.Close
MsgBox "Max presseure is " & MaxX
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.