修改同路径的txt的指定内容

lhj323323

老师：


上传的附件里，已有一段VBA代码，能实现修改一个指定的ID里的内容。
但如果要实现如下图的效果，就搞不定了
老师如有空，请帮忙看看
先谢谢了

求助20230707.rar (220.71 KB, 下载次数: 7)

2023-7-7 10:38 上传

点击文件名下载附件

wanghan519

没有检查，请小心试用

1. Public Sub t()
   
2.     Dim xml As Object
   
3.     Dim node As Object
   
4.     Dim nd As Object
   
5.     Set xml = CreateObject("MSXML2.DOMDocument")
   
6.     xml.Load ThisWorkbook.Path & "\111A.txt"
   
7.     For Each node In xml.SelectNodes("//cell")
   
8.         Select Case node.getAttribute("id")
   
9.             Case "1"
   
10.                 node.SetAttribute "text", "北京"
    
11.             Case "4"
    
12.                 node.SetAttribute "text", "南京"
    
13.             Case "2"
    
14.                 node.SetAttribute "text", "哈哈"
    
15.                 For Each nd In node.SelectNodes("stk")
    
16.                     node.RemoveChild nd
    
17.                 Next
    
18.             Case "6"
    
19.                 node.SetAttribute "text", "嘻嘻"
    
20.                 For Each nd In node.SelectNodes("stk")
    
21.                     node.RemoveChild nd
    
22.                 Next
    
23.         End Select
    
24.     Next
    
25.     xml.Save ThisWorkbook.Path & "\111B.txt"
    
26. End Sub

复制代码

lhj323323

wanghan519 发表于 2023-7-7 14:27
没有检查，请小心试用

谢谢老师！

我把您和解0人老师的代码，如下这么合并，还能再简化一下吗？

1. Sub test()
   
2. '第一步，先写入到id 1 'by excelhome论坛 解0人
   
3. Dim str$
   
4. Dim Myr%, arr
   
5. Dim i&, s$, s1$, s2$, reg
   
6.    Open ThisWorkbook.Path & "/111A.TXT" For Binary As #1
   
7.    i = LOF(1)
   
8.     str = Input(i, 1)
   
9.     Close #1
   
10. 
    
11. With Sheet3
    
12.      Myr = .Range("a65536").End(xlUp).Row
    
13.      arr = .Range("a2:b" & Myr)
    
14.      
    
15.     For i = 1 To UBound(arr)
    
16.         s = arr(i, 1)
    
17.         s1 = s1 & "<stk setcode=""" & d & """ code=""" & s & """/>"
    
18.     Next
    
19. End With
    
20. Set reg = CreateObject("VBScript.RegExp")
    
21. With reg
    
22.     .MultiLine = True
    
23.     .Pattern = "(<cell id=""1"" .+?>\s*)(<.*?>)?(\s*<\/cell>)"
    
24.     str = .Replace(str, "$1" & s1 & "$3")
    
25. End With
    
26. Set reg = Nothing
    
27. Open ThisWorkbook.Path & "/111C.txt" For Output As #1 '---------------------暂存到111C.txt,下面的第二步再进行修改
    
28. 
    
29. Print #1, str
    
30. Close #1
    
31. 
    
32. '第二步，再根据不同的id进行改名，by excelhome论坛 wanghan519 EH高级
    
33.     Dim xml As Object
    
34.     Dim node As Object
    
35.     Dim nd As Object
    
36.     Set xml = CreateObject("MSXML2.DOMDocument")
    
37.     xml.Load ThisWorkbook.Path & "\111C.txt" '-----------------------------再从111C.txt进行修改
    
38.     For Each node In xml.SelectNodes("//cell")
    
39.         Select Case node.getAttribute("id")
    
40.             Case "1"
    
41.                 node.SetAttribute "text", "北京"
    
42.             Case "4"
    
43.                 node.SetAttribute "text", "南京"
    
44.             Case "2"
    
45.                 node.SetAttribute "text", "哈哈"
    
46.                 For Each nd In node.SelectNodes("stk")
    
47.                     node.RemoveChild nd
    
48.                 Next
    
49.             Case "6"
    
50.                 node.SetAttribute "text", "嘻嘻"
    
51.                 For Each nd In node.SelectNodes("stk")
    
52.                     node.RemoveChild nd
    
53.                 Next
    
54.         End Select
    
55.     Next
    
56.     xml.Save ThisWorkbook.Path & "\111C.txt" '-----------------------------定稿于111C.txt
    
57. End Sub

复制代码