文件编辑自动化
文件编辑自动化
提问于 2021-12-25 05:39:01
我只想用宏重命名一个文件夹中的两个文件，虽然该文件夹中有很多文件，但无法这样做。我想将文件名从"N2“重命名为"NORTH 2 (UP/UK)”，将"N3“重命名为"NORTH 3 (HR/PB)”。另外，我需要将第一列中的所有值重命名为"zone"，从"N2“重命名为"NORTH 2 (UP/UK)”，并将"N3“重命名为"NORTH 3 (HR/PB)”，使用每个文件中第一列的动态范围。
我只想点击一个按钮，这个任务想要自动化。编译器自动重命名文件，逐一打开每个文件，并按照上述条件替换现有的区域值，并保存更改。
问:如何将动态范围分配给代码.Worksheets(1).Cells(2，1)
请参阅下列代码：
尝试重命名文件时获取运行时错误53
Option Explicit
Sub FileOpen_Macro()
Dim FileName(0 To 1) As String
Dim ReplaceName(0 To 1) As String
Dim ReplaceZoneName(0 To 1) As String
'Dim FileName As String
Const MyPath As String = "D:\iWork\Dunning Report\Dec'21\Result\"
Dim strNewName As String
Dim i As Long
FileName(0) = "N2"
FileName(1) = "N3"
ReplaceName(0) = "North-2(UPUK).xlsx"
ReplaceName(1) = "North-3(HRPB).xlsx"
ReplaceZoneName(0) = "NORTH 2 (UP/UK)"
ReplaceZoneName(1) = "NORTH 3 (HR/PB)"
For i = 0 To 1
'strNewName = Replace(FileName(i), "N", ReplaceName(i))
strNewName = Replace(FileName(i) & ".xlsx", FileName(i) & ".xlsx", ReplaceName(i))
Name MyPath & FileName(i) & ".xlsx" As MyPath & ReplaceName(i)
With Workbooks.Open(FileName:=MyPath & strNewName)
' Replace the cell A1 of the first sheet.
.Worksheets(1).Cells(2, 1) = Replace(.Worksheets(1).Cells(2, 1), FileName(i), ReplaceZoneName(i))
'and Save & close
.Close SaveChanges:=True
End With
MsgBox strNewName
Next i
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2021-12-25 16:39:50
使用Range.Replace更新范围内的所有单元格。
Sub Replace_Macro()
Const MyPath As String = "D:\iWork\Dunning Report\Dec'21\Result\"
Dim sOld as string, sNew as string, sZone As String
Dim lastrow As Long, i As Long, ar(1)
ar(0) = Array("N2", "North-2(UPUK)", "NORTH 2 (UP/UK)")
ar(1) = Array("N3", "North-3(HRPB)", "NORTH 3 (HR/PB)")
For i = 0 To UBound(ar)
sOld = ar(i)(0) & ".xlsx"
sNew = ar(i)(1) & ".xlsx"
sZone = ar(i)(2)
' check file exists
If Dir(MyPath & sOld) <> "" Then
With Workbooks.Open(MyPath & sOld)
With .Sheets(1)
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
' update column A
.Range("A2:A" & lastrow).Replace _
What:=ar(i)(0), Replacement:=sZone, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
MatchCase:=True
End With
' save as new name
.SaveAs FileName:=MyPath & sNew
.Close False
End With
' delete old file
If Dir(MyPath & sNew) <> "" Then
Kill MyPath & sOld
End If
Else
MsgBox MyPath & sOld & " does not exist", vbCritical
End If
Next i
MsgBox "Done"
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70478185
复制相关文章
相似问题
腾讯云开发者
