使用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，它们都采用相同的测量但具有不同的偏移量。这是我从Spreadsheet Guru尝试的一些演示代码：

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，Left和Mid函数的组合：

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上拆分，以便每个度量都是自己的数组元素。它过滤该数组以找到正确的度量。旧措施取而代之的是新措施。然后用新标题替换旧标题。

如果您传入的内容不在文件中，则会收到错误消息。所以你应该建立一些错误检查。

更新：降序措施

上面的代码假定Measures在文件中以升序显示。如果它们正在下降，您可以使用

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

Filter()函数返回数组通配符匹配的数组。如果您搜索700，则返回的数组将包含2700，1700和700（假设它们都存在）。 Filter(...)(0)语法返回第一个元素 - 用于提升。 Filter(...)(Ubound(Filter(...)))返回最后一个元素 - 如果它们按降序排序则有效。

更新：未排序的措施

此版本引入了一些特殊字符，以确保您只替换Measures字符串的完全匹配

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

您可以使用Excel功能（如果您已经在使用Excel :)另一个方法。），
加载 - ＆gt; TEXTFILES
搜索 - ＆gt;值
重写 - ＆gt;文本文件

但是必须优化代码

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