使用 Excel VBA 更新文本文件
Update text file with 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/Ns，它们都采用相同的测量但具有不同的偏移量。这是我从 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
代码有效，但它会更新任何显示 "Inserting new line" 和 "blah blah blah." 的内容，我希望一旦找到“[HEADER TEST]”，它只会替换一次。 14=]
我的问题有两个：
我如何只更改文件中一个 S/N 的测量值“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
它在 [ 上拆分原始文件，因此每个 header 都是它自己的行。然后它会根据您发送的任何 header 过滤该数组，但会在其末尾添加一个 ]，因此不会出现错误匹配。
一旦找到正确的 header，它就会在 vbNewLine 上拆分它，以便每个度量都是它自己的数组元素。它过滤该数组以找到正确的度量。它用新措施取代了旧措施。然后将旧的 header 替换为新的 header.
如果您传入文件中没有的内容，您将收到错误消息。所以你应该在其中建立一些错误检查。
更新：降序测量
以上代码假设 Measures 在文件中按升序排列。如果它们是下降的，你可以使用
sOldMeas = Filter(vaMeasures, sMeasure & ":")(UBound(Filter(vaMeasures, sMeasure & ":")))
Filter()函数returns一个数组的通配符匹配数组。如果搜索 700，返回的数组将包含 2700、1700 和 700（假设它们都存在）。 Filter(...)(0) 语法 returns 第一个元素 - 适用于升序。 Filter(...)(Ubound(Filter(...))) returns 最后一个元素 - 如果它们按降序排列则有效。
更新：未排序的度量
此版本引入了一些特殊字符，以便您确保仅替换与 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。
您可以使用 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"))
.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
我正在编写一个 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/Ns，它们都采用相同的测量但具有不同的偏移量。这是我从 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
代码有效，但它会更新任何显示 "Inserting new line" 和 "blah blah blah." 的内容，我希望一旦找到“[HEADER TEST]”，它只会替换一次。 14=]
我的问题有两个：
我如何只更改文件中一个 S/N 的测量值“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
它在 [ 上拆分原始文件，因此每个 header 都是它自己的行。然后它会根据您发送的任何 header 过滤该数组，但会在其末尾添加一个 ]，因此不会出现错误匹配。
一旦找到正确的 header，它就会在 vbNewLine 上拆分它，以便每个度量都是它自己的数组元素。它过滤该数组以找到正确的度量。它用新措施取代了旧措施。然后将旧的 header 替换为新的 header.
如果您传入文件中没有的内容，您将收到错误消息。所以你应该在其中建立一些错误检查。
更新：降序测量
以上代码假设 Measures 在文件中按升序排列。如果它们是下降的，你可以使用
sOldMeas = Filter(vaMeasures, sMeasure & ":")(UBound(Filter(vaMeasures, sMeasure & ":")))
Filter()函数returns一个数组的通配符匹配数组。如果搜索 700，返回的数组将包含 2700、1700 和 700（假设它们都存在）。 Filter(...)(0) 语法 returns 第一个元素 - 适用于升序。 Filter(...)(Ubound(Filter(...))) returns 最后一个元素 - 如果它们按降序排列则有效。
更新：未排序的度量
此版本引入了一些特殊字符，以便您确保仅替换与 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。
您可以使用 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"))
.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