用Excel VBA更新文本文件

Question

我正在寫一個Excel VBA程序來測量設備並更新各種讀數值。以下是對我的文件看起來像一個簡單的例子：

[11904] 
400: 0.4 
500: 0.3 
600: 3.3 

[11905] 
400: 1.0 
500: 2.0 
600: 3.0 

正在使用中的括號中的數字設備的S/N，大數是測量和冒號後面的數字是設備的偏移值。我想要做的是寫一些能夠定位S/N，定位測量值，然後覆蓋偏移值的東西。 .ini文件具有很多S/N，它們都採用相同的測量，但具有不同的偏移量。下面是一些演示代碼，我從電子表格大師嘗試：

Private Sub CommandButton1_Click() 
'PURPOSE: Modify Contents of a text file using Find/Replace 
'SOURCE: www.TheSpreadsheetGuru.com 

Dim TextFile As Integer 
Dim FilePath As String 
Dim FileContent As String 

'File Path of Text File 
FilePath = "C:\Temp\test.ini" 

'Determine the next file number available for use by the FileOpen function 
TextFile = FreeFile 

'Open the text file in a Read State 
Open FilePath For Input As TextFile 

'Store file content inside a variable 
FileContent = Input(LOF(TextFile), TextFile) 

'Clost Text File 
Close TextFile 

'Find/Replace 
FileContent = Replace(FileContent, "[HEADER TEST]", "[HEADER TEST]") 
FileContent = Replace(FileContent, "Inserting new line", "Replacing line") 
FileContent = Replace(FileContent, "Blah blah blah", "replaced this line too!") 

'Determine the next file number available for use by the FileOpen function 
TextFile = FreeFile 

'Open the text file in a Write State 
Open FilePath For Output As TextFile 

'Write New Text data to file 
Print #TextFile, FileContent 

'Clost Text File 
Close TextFile 
End Sub 

代碼工作，但它更新什麼，說：「插入新行」和「等等等等等等。」我希望只有在找到「[HEADER TEST]」後才能取代一次。「

我的問題是雙重的：

如何只改變，比方說，僅僅用一個S/N在文件中測量「400」？

此外，一旦我找到文本我想改變，我怎麼只寫偏移值而不是整個字符串？

如果我能夠成功找到一條線並只編輯一條線，我可以根據需要更換整個字符串。我無法更改.ini的格式，因爲我們使用讀取它的程序。

Answer 1

僅替換第一次出現，你應該使用的StrPos，左和中的功能組合：

if strpos(FileContent, "blabla") > 0 then 
    contentBeforeMatch = Left(FileContent, strpos(FileContent, "blabla") -1) 
    contentAfterMatch = Mid(FileContent, strpos(FileContent, "blabla") + Len("blabla") - 1)) 
    FileContent = contentBeforeMatch & "New Value" & contentAfterMatch 
end if 

Answer 2

您可以考慮使用過濾，分離，並立即加入到隔離所要更改的區域。這裏有一個例子

Sub ReplaceOffset(ByVal sHead As String, ByVal sMeasure As String, ByVal dValue As Double) 

    Dim sFile As String, lFile As Long 
    Dim vaLines As Variant 
    Dim vaMeasures As Variant 
    Dim sOld As String, sNew As String, sOldMeas 
    Dim i As Long 

    lFile = FreeFile 
    sFile = "C:\Temp\Test.ini" 

    'Read in the file to an array 
    Open sFile For Input As lFile 
     vaLines = Split(Input$(LOF(lFile), lFile), "[") 
    Close lFile 

    'Filter to find the right header 
    sOld = Filter(vaLines, sHead & "]")(0) 
    'Split the header into measurements 
    vaMeasures = Split(sOld, vbNewLine) 

    'Get the old value 
    sOldMeas = Filter(vaMeasures, sMeasure & ":")(0) 
    'Replace old With new 
    sNew = Replace(sOld, sOldMeas, sMeasure & ": " & Format(dValue, "0.0")) 

    'Replace the old With the new and write it out to the file 
    lFile = FreeFile 
    Open sFile For Output As lFile 
     Print #lFile, Replace(Join(vaLines, "["), sOld, sNew) 
    Close lFile 

End Sub 

你這樣稱呼它

ReplaceOffset "11906","500",.1 

它分割上[原始文件，以便每個頭是它自己的線。然後它會過濾該數組，無論您發送的是什麼頭文件，但會在其末尾添加]，因此不會出現錯誤匹配。

一旦找到正確的標題，它會將其分割爲vbNewLine，以便每個度量都是它自己的數組元素。它過濾該數組以找到正確的度量。舊措施取代新措施。然後舊頭被替換爲新頭。

如果你傳入不在文件中的東西，你會得到一個錯誤。所以你應該建立一些錯誤檢查。

更新：降序措施

上面的代碼假定辦法在文件中出現上升。如果它們被降，則可以使用

sOldMeas = Filter(vaMeasures, sMeasure & ":")(UBound(Filter(vaMeasures, sMeasure & ":"))) 

的Filter()函數返回數組的通配符匹配的數組。如果搜索700，返回的數組將包含2700,1700和700（假設它們全都存在）。 Filter(...)(0)語法返回第一個元素 - 用於升序。 Filter(...)(Ubound(Filter(...)))返回最後一個元素 - 如果它們按降序排序，則工作。

更新：未分類的辦法

該版本引入了一些特殊的字符，以便確保你只更換措施字符串的精確匹配

Sub ReplaceOffset(ByVal sHead As String, ByVal sMeasure As String, ByVal dValue As Double) 

    Dim sFile As String, lFile As Long 
    Dim vaLines As Variant 
    Dim vaMeasures As Variant 
    Dim sOld As String, sNew As String, sOldMeas 
    Dim i As Long 

    lFile = FreeFile 
    sFile = "C:\Temp\Test.ini" 

    'Read in the file to an array 
    Open sFile For Input As lFile 
     vaLines = Split(Input$(LOF(lFile), lFile), "[") 
    Close lFile 

    'Filter to find the right header 
    sOld = Filter(vaLines, sHead & "]")(0) 
    sOld = Replace$(sOld, vbNewLine, vbNewLine & "~") 

    'Get the old value if Measures are unsorted 
    vaMeasures = Split(sOld, vbNewLine) 
    sOldMeas = Filter(vaMeasures, "~" & sMeasure & ":")(0) 

    'Replace old With new 
    sNew = Replace(sOld, sOldMeas, sMeasure & ": " & Format(dValue, "0.0")) 
    sNew = Replace(sNew, vbNewLine & "~", vbNewLine) 
    sOld = Replace(sOld, vbNewLine & "~", vbNewLine) 

    'Replace the old With the new and write it out to the file 
    lFile = FreeFile 
    Open sFile For Output As lFile 
     Print #lFile, Replace(Join(vaLines, "["), sOld, sNew) 
    Close lFile 

End Sub 

原來2700:, 1700:, 700:爲~2700:, ~1700:, ~700:所以當您搜索~700:時，無論排序順序如何，都不會獲得2700。

Answer 3

另一個approche你可以使用Excel功能（如果您已經使用Excel :)），
負載 - > TEXTFILES
搜索 - >值
重寫 - >文本文件

但代碼將不得不優化

Private Sub CommandButton1_Click() 

    Dim NewValue As String 
    Dim FilePath As String 
    Dim Index As Integer 
    Dim TextRow 

    FilePath = "C:\Temp\test.ini" 

    SearchValue = "[11905]" 
    ChangeValue = "400" 
    NewValue = "123" 

    With ActiveSheet.QueryTables.Add(Connection:= _ 
     "TEXT;" + FilePath, Destination:=Range("$A$1")) 
     .TextFileStartRow = 1 
     .TextFileParseType = xlDelimited 
     .TextFileOtherDelimiter = ":" 
     .TextFileColumnDataTypes = Array(1, 1) 
     .Refresh BackgroundQuery:=False 
    End With 

    ' search for key 
    Cells.Find(What:=SearchValue, After:=ActiveCell, LookIn:=xlFormulas, _ 
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate 

    ' search for value to change 
    Cells.Find(What:=ChangeValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ 
     xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
     , SearchFormat:=False).Activate 

    ' change Value 
    ActiveCell.FormulaR1C1 = NewValue 

    ' select bottom row start 
    Range("A1").Select 
    Selection.End(xlToRight).Select 
    Selection.End(xlDown).Select 
    Selection.End(xlToLeft).Select 
    Selection.End(xlUp).Select 
    ' select bottom row end 

    ' select all rows 
    Range(Range("A1"), Selection).Select 

    ' write file 
    Open FilePath For Output As #1 

     'Write New Text data to file 
     For Index = 1 To Selection.Rows.Count + 1 
      TextRow = Selection.Cells(Index, 1).FormulaR1C1 
      If InStr(1, TextRow, "[") = 0 And Not TextRow = "" Then 
       TextRow = TextRow + ":" + Selection.Cells(Index, 2).FormulaR1C1 
      End If 
      Print #1, TextRow 
     Next Index 

    Close #1 

End Sub