在 TXT 文件中查找值并替换为 Excel 单元格中的值

Question

我正在寻找一个宏来查找和替换 txt 文件中的值。

txt文件位于路由中

D:\Template\info.txt

这个文件长这样（确实文件有HTML代码，但我这里合成了重要的部分）

The current date and time is: %time%

GPU1 Temperature is: %GPU1T%
GPU1 Fan Speed is: %GPU1F%
GPU1 RPM are: %GPU1R%

GPU2 Temperature is: %GPU2T%
GPU2 Fan Speed is: %GPU2F%
GPU2 RPM are: %GPU2R%

Excel 文件看起来像这样

我需要的是一个可以查找和替换以下内容的宏：

Find %time% in the txt file and replace with the value of cell G2
Find %GPU1T% in the txt file and replace with the value of cell A2
Find %GPU1F% in the txt file and replace with the value of cell C2
Find %GPU1R% in the txt file and replace with the value of cell E2
Find %GPU2T% in the txt file and replace with the value of cell B2
Find %GPU2F% in the txt file and replace with the value of cell D2
Find %GPU2R% in the txt file and replace with the value of cell F2

然后，当然保存文件，但在一个新的位置，即

D:\GPUReport

但名称相同info.txt

到目前为止，尝试处理这个宏没有成功

Sub FindAndReplaceText()

 Dim FileName As String
 Dim FolderPath As String
 Dim FSO As Object
 Dim I As Integer
 Dim SearchForWords As Variant
 Dim SubstituteWords As Variant
 Dim Text As String
 Dim TextFile As Object
 

   SearchForWords = Array("%time%", "%GPU1T%", "%GPU1F%", "%GPU1R%", "%GPU2T%", "%GPU2F%", "%GPU2R% ")
   SubstituteWords = Array(Range("G2"), Range("A2"), Range("C2"), Range("E2"), Range("B2"), Range("D2"), Range("F2"))
 

   FolderPath = "D:\Template\info.txt"
   
     Set FSO = CreateObject("Scripting.FileSystemObject")
   
     FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
     FileName = Dir(FolderPath & "\*.txt")
   
     Do While FileName <> ""
       Filespec = FolderPath & FileName

         Set TextFile = FSO.OpenTextFile(Filespec, 1, False)
           Text = TextFile.ReadAll
         TextFile.Close
         

         Set TextFile = FSO.OpenTextFile(Filespec, 2, False)
           For I = 0 To UBound(SearchForWords)
             Replace Text, SearchForWords(I), SubstituteWords(I)
           Next I
         TextFile.Write Text
         TextFile.Close
       FileName = Dir()
     Loop
     
End Sub

我希望有人可以帮助我。

非常感谢您！

Answer 1

试试这样的：

Sub Tester()
    Dim txt As String, arr, c As Long
    
    arr = ThisWorkbook.Sheets("config").Range("A1:G2").Value
    txt = GetContent("C:\Tester\info.txt")
    For c = 1 To UBound(arr, 2)
        txt = Replace(txt, "%" & arr(1, c) & "%", arr(2, c))
    Next c
    PutContent "C:\Tester\info2.txt", txt
End Sub

Function GetContent(f As String) As String
    GetContent = CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 1).readall()
End Function

Sub PutContent(f As String, content As String)
    CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 2, True).write content
End Sub

编辑：刚刚注意到您的标头与占位符标记不同，但使它们相同会更容易（但不要在标头周围包含“%”）。或者在列标题下添加另一行以包含该列的占位符文本。