[已解决]Excel修改文本中特定行内容

jmkite

工作原因，要批量修改下文本中特定的内容，研究下如果用VBA实现，请各位高手指点指点。谢谢！

最佳答案

月排行榜 / 总排行榜

lichuanboy44

2016-3-26 18:23

已成功调试，代码如下：你将程序中的备注文件夹恢复，同时将我的当前工作簿文件夹更换掉，就可实现你指定的文件夹移动或复制了。便于调试，用thisworkbook.path较方便，无论你怎么复制或移动该程序都能正常运行。
原来你的nc1文件，也能用Workbooks.Open打开，这样也不难了，只是费时间调试。

1. Sub 复制修改()
   
2.     If [C3] = "已复制" Then
   
3.         tf = MsgBox("文件已复制，是否删除后再进行" & vbCrLf & vbCrLf & _
   
4.                     "点""确定""则删除", vbQuestion + vbOKCancel)
   
5.         If tf = vbYes Then
   
6.             Call 删除测试文件
   
7.         Else
   
8.             Exit Sub
   
9.         End If
   
10.     End If
    
11.     'Path = [A3]      '原夹
    
12.     'topath = [B3]    '目标夹
    
13.     Path = ThisWorkbook.Path & "\1"      '原夹
    
14.     topath = ThisWorkbook.Path & "\2"    '目标夹
    
15.     f = Dir(Path & "*.nc*")
    
16.     If f <> "" Then
    
17.         Do While Len(f)
    
18.             FileCopy Path & f, topath & f
    
19.             f = Dir()
    
20.         Loop
    
21.         Call 复制或移动修改
    
22.         [C3] = "已复制"
    
23.     End If
    
24. End Sub

复制代码

1. Sub 复制或移动修改()
   
2.     Application.ScreenUpdating = False
   
3.     Set sh = Sheets("Excel修改Tekla板NC文件中的数量")
   
4.     n = sh.Range("A65536").End(3).Row
   
5.     arr = sh.Range("A5:B" & n)
   
6.     'topath = [B3]    '目标夹
   
7.     topath = ThisWorkbook.Path & "\2"    '目标夹
   
8.     For i = 1 To n - 4
   
9.         s = topath & arr(i, 1) & ".nc1"
   
10.         f = Dir(s)
    
11.         If f <> "" Then
    
12.             Set wt = Workbooks.Open(s)
    
13.             With wt
    
14.                 .Sheets(1).Cells(8, 1) = "'  " & arr(i, 2)
    
15.                 .Close True
    
16.             End With
    
17.             p = p + 1
    
18.         End If
    
19.     Next
    
20.     MsgBox "移动修改成功" & p & "个NC文件！"
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码

跳转到最佳答案楼层

lichuanboy44

可能是没完全明白你的意思，但觉得你提取指定文件夹下的带nc的文件名，弄得好复杂，以下代码就可以了：

1. Sub 提取文件名2()
   
2.     Dim ar
   
3.     Set SH1 = Sheets("Excel修改Tekla板NC文件中的数量")
   
4.     Path = ThisWorkbook.Path & "\1"
   
5.     myfile = Dir(Path & "*.nc*")
   
6.     p = 1
   
7.     ReDim ar(1 To p)
   
8.     Do While myfile <> ""
   
9.         ReDim Preserve ar(1 To p)
   
10.         ar(p) = myfile
    
11.         p = p + 1
    
12.         myfile = Dir
    
13.     Loop
    
14.     [A5:A2000].ClearContents
    
15.     [A5].Resize(p - 1, 1) = WorksheetFunction.Transpose(ar)
    
16.     MsgBox "成功提取文件名！"
    
17. End Sub

复制代码

jmkite

lichuanboy44 发表于 2016-3-26 14:09
可能是没完全明白你的意思，但觉得你提取指定文件夹下的带nc的文件名，弄得好复杂，以下代码就可以了：

嗯，谢谢你这么简洁的代码。
excel表格上板文件名对应就是nc文件的文件，数量就是修改相应NC文件中第八行的数量数据。
提取文件名的意思是提取A3路径中的文件名，列表出来，我已经实现了。
原位修改的意思是直接修改A3路径中相应NC文件中第八行的数据，即数量数据。。
移动修改的意思是先把NC文件从A3目录剪切到B3目录下，再修改里面第八行的数据，即数量数据。
复制修改的意思是先把NC文件从A3目录复制到B3目录下，再修改里面第八行的数据，即数量数据。

jmkite

lichuanboy44 发表于 2016-3-26 14:09
可能是没完全明白你的意思，但觉得你提取指定文件夹下的带nc的文件名，弄得好复杂，以下代码就可以了：

嗯，谢谢你这么简洁的代码。试了下，可以，但我想列出的文件名不带扩展名，我这样写，不知有没有Bug存在，请指教。

1. Sub 提取文件名_单击()
   
2.     Dim ar
   
3.     Set SH1 = Sheets("Excel修改Tekla板NC文件中的数量")
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Path = ThisWorkbook.Path & "\1"
   
6.     myfile = Dir(Path & "*.nc1*")
   
7.     p = 1
   
8.     ReDim ar(1 To p)
   
9.     Do While myfile <> ""
   
10.         ReDim Preserve ar(1 To p)
    
11.         ar(p) = fso.getbasename(myfile)
    
12.         p = p + 1
    
13.         myfile = Dir
    
14.     Loop
    
15.     [A5:A2000].ClearContents
    
16.     [A5].Resize(p - 1, 1) = WorksheetFunction.Transpose(ar)
    
17.     MsgBox "成功提取文件名！"
    
18. End Sub
    

复制代码

lichuanboy44

jmkite 发表于 2016-3-26 14:28
嗯，谢谢你这么简洁的代码。试了下，可以，但我想列出的文件名不带扩展名，如何实现。谢谢！

将原程序的中的ar(p) =myfile修改为 ar(p) = Replace(myfile, ".nc1", "")，即可
你说的要修改nc1文件的第8行数据，这点我没实现，我尝试用Open wj For Output As #1，即二进制打开文件，但打开后，原来文件的数据全部没有了，无法读，更无法写入，修改，在此留给其它高手了，不知你的nc1是什么程序导出的。
另外，我也用Shell"notepad " & Path & "\2\N1.nc1", vbNormalFocus打开文件，但只能打开，但无法设置和修改

jmkite

lichuanboy44 发表于 2016-3-26 14:59
将原程序的中的ar(p) =myfile修改为 ar(p) = Replace(myfile, ".nc1", "")，即可
你说的要修改nc1文件 ...

*.nc1是数控文件来的，是一个软件导出来的数控数据，其实是txt文件来的，只是它修改了扩展名用来区分txt文件。你说的打不开文件，其实有种思路，可以先把文件修改成.txt扩展名先，再修改第八行的数据，修改保存好后，再把扩展名自动修改回.nc1

lichuanboy44

jmkite 发表于 2016-3-26 15:05
*.nc1是数控文件来的，是一个软件导出来的数控数据，其实是txt文件来的，只是它修改了扩展名用来区分txt文 ...

试了的，将后缀修改为txt后，用经常用的二进制打开后，数据仍然全部没有了
但刚试，又可以了****

lichuanboy44

已成功调试，代码如下：你将程序中的备注文件夹恢复，同时将我的当前工作簿文件夹更换掉，就可实现你指定的文件夹移动或复制了。便于调试，用thisworkbook.path较方便，无论你怎么复制或移动该程序都能正常运行。
原来你的nc1文件，也能用Workbooks.Open打开，这样也不难了，只是费时间调试。

1. Sub 复制修改()
   
2.     If [C3] = "已复制" Then
   
3.         tf = MsgBox("文件已复制，是否删除后再进行" & vbCrLf & vbCrLf & _
   
4.                     "点""确定""则删除", vbQuestion + vbOKCancel)
   
5.         If tf = vbYes Then
   
6.             Call 删除测试文件
   
7.         Else
   
8.             Exit Sub
   
9.         End If
   
10.     End If
    
11.     'Path = [A3]      '原夹
    
12.     'topath = [B3]    '目标夹
    
13.     Path = ThisWorkbook.Path & "\1"      '原夹
    
14.     topath = ThisWorkbook.Path & "\2"    '目标夹
    
15.     f = Dir(Path & "*.nc*")
    
16.     If f <> "" Then
    
17.         Do While Len(f)
    
18.             FileCopy Path & f, topath & f
    
19.             f = Dir()
    
20.         Loop
    
21.         Call 复制或移动修改
    
22.         [C3] = "已复制"
    
23.     End If
    
24. End Sub

复制代码

1. Sub 复制或移动修改()
   
2.     Application.ScreenUpdating = False
   
3.     Set sh = Sheets("Excel修改Tekla板NC文件中的数量")
   
4.     n = sh.Range("A65536").End(3).Row
   
5.     arr = sh.Range("A5:B" & n)
   
6.     'topath = [B3]    '目标夹
   
7.     topath = ThisWorkbook.Path & "\2"    '目标夹
   
8.     For i = 1 To n - 4
   
9.         s = topath & arr(i, 1) & ".nc1"
   
10.         f = Dir(s)
    
11.         If f <> "" Then
    
12.             Set wt = Workbooks.Open(s)
    
13.             With wt
    
14.                 .Sheets(1).Cells(8, 1) = "'  " & arr(i, 2)
    
15.                 .Close True
    
16.             End With
    
17.             p = p + 1
    
18.         End If
    
19.     Next
    
20.     MsgBox "移动修改成功" & p & "个NC文件！"
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码