使用VBA实现文件固定行内容批量修改

limonet

关键字：set-content

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & "\Txt;$h=@{23='<S>20.2024030037259</S>';24='<S>387</S>';25='<S>5024.8</S>'};dir | " _
    & "%{$TxtA =Get-Content $_;ForEach ($i in $h.keys){$TxtA[$i] =$TxtA[$i] -replace '<S>.*</S>',$h[$i]}; " _
    & "Set-Content  $_ -Value $TxtA}", 0
End Sub

ykcbf1100

雷沛qaz 发表于 2024-6-16 19:15
不是，本想着用字符识别替换的，但有字符相同的，所以只能用行数来识别

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.16
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     st = "<TEST_Q>"
   
6.     b = [{"        <S>20.2024030037259</S>","              <S>387</S>","        <S>5024.8</S>"}]
   
7.     p = ThisWorkbook.Path & ""
   
8.     For Each f In fso.GetFolder(p).Files
   
9.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
10.             Set wb = Workbooks.Open(f, 0)
    
11.             With wb.Sheets(1)
    
12.                 arr = .UsedRange
    
13.                 For i = 1 To UBound(arr)
    
14.                     If InStr(arr(i, 1), st) And Len(arr(i, 1)) = 8 Then
    
15.                         r = i
    
16.                         Exit For
    
17.                     End If
    
18.                 Next
    
19.                 For x = 1 To 3
    
20.                     .Cells(r - 4 + x, 1) = b(x)
    
21.                 Next
    
22.             End With
    
23.             wb.Close 1
    
24.         End If
    
25.     Next f
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码