使用Excel VBA更新文本文件
我正在写一个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
该代码的作品，但它更新任何说“插入新行”和“等等等等等等。 我希望一旦find了“[HEADER TEST]”，就只能取代一次。
我的问题是双重的：
我怎样才能改变文件中只有一个S / N的测量“400”？
另外，一旦我find文本，我想改变，我怎么只写偏移值，而不是整个string？
如果我能够成功find一条线，只编辑一条线，我可以根据需要更换整个string。 我无法更改.ini的格式，因为我们使用读取它的程序。
要仅replace第一次出现，您应该使用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
您可以考虑使用“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) '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
它将原始文件分割[这样每个头是它自己的行。 然后它过滤那个数组在你发送的任何头上，但是在它的结尾添加一个] ，所以没有错误的匹配。
一旦find正确的标题，就会在vbNewLine上分割它，这样每个小节就是它自己的数组元素。 它过滤该数组以find正确的度量。 旧措施取而代之的是新措施。 然后旧的标题被replace为新的标题。
如果你传入不在文件中的东西，你会得到一个错误。 所以你应该build立一些错误检查。
更新：降序措施
上面的代码假设“度量值”在文件中以升序显示。 如果他们正在下降，你可以使用
sOldMeas = Filter(vaMeasures, sMeasure & ":")(UBound(Filter(vaMeasures, sMeasure & ":")))
Filter()函数返回数组的通配符匹配。 如果search700 ，则返回的数组将包含2700和700 （假设它们全都存在）。 Filter(...)(0)语法返回第一个元素 – 用于升序。 Filter(...)(Ubound(Filter(...)))返回最后一个元素 – 如果它们按降序sorting，则返回结果。
更新：未分类的措施
此版本引入了一些特殊字符，以确保您只replace度量string的完全匹配
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:这样当你search〜700时，无论sorting顺序如何，你都不会得到2700。
另一个你可以使用Excelfunction（如果你已经使用Excel :)）
加载 – >文本文件
search – >值
重写 – >文本文件
但是守则将不得不被优化
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