使用Excel VBA更新文本文件

我正在编写一个Excel VBA程序，用于测量设备并更新各种读数的值。下面是我的文件的一个简短示例：

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

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

括号中的数字是所用设备的序列号，大的数字是测量值，冒号后的数字是设备的偏移值。我想做的是写一些东西来定位序列号，定位测量值，然后覆盖偏移值。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

代码是有效的，但它会更新“插入新行”和“诸如此类”的任何内容。我希望在找到“[标题测试]”后，它只会替换一次出现的内容

我的问题有两个方面：

我如何仅为文件中的一个序列号更改度量值“400”

此外，一旦找到要更改的文本，如何只写入偏移量值而不是整个字符串

---

如果我能够成功地定位一行并且只编辑一行，那么如果需要，我可以替换整个字符串。我无法更改.ini的格式，因为我们使用的是读取该格式的程序。

要仅替换第一次出现的格式，应结合使用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

---

您可以考虑使用筛选器、拆分和连接来隔离要更改的区域。这里有一个例子

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

（假设它们都存在）。

过滤器（…）（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。

另一种方法是使用Excel功能（如果您已经在使用Excel:），
加载文本文件
搜索->值
重写文本文件

但代码必须进行优化

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

---

返回的错误是未定义“strpos”。这不是Excel VBA中的默认函数？编辑：在InStr中被替换，似乎可以工作…需要更多地使用它来做我想做的事情。我的第一次尝试去掉了标题，我想保留标题，只需替换标题下的一两行即可。有没有办法替换整个文本块？对于我的应用程序，我希望替换20多行代码。谢谢所以，这都是关于使用字符串函数的——您需要为块定义开始和结束表达式。然后，您只需搜索起点，获取它之前的所有内容（使用Left（）funct），然后搜索终点（不要忘记指定起点位置超过起点块），然后获取所有内容超过终点块。然后，您只需连接开始块、新块和结束块之前的所有内容。就是这样：）太棒了！调整了一下，让它做我想做的。谢谢：）嗨，迪克，看起来很酷。我得试一试。谢谢：）嗨，迪克，代码在打嗝的时候很有用。我正在做一个从500到2700的范围。这一切都很好，因为我将文件中的值替换为2700-1000（不幸的是，文本文件从高到低），但一旦我达到900-500，1900、1800、2700、2600和2500的值将改变，而不是预期的900-500。如何修改过滤器，使其仅在文件标题后的确切字符串存在时才更改？过滤函数后的（0）是否有任何影响？我以前从未见过这种格式…@Alex我添加了一些降序和未排序度量的代码。