Sub changeFile()
'出错时直接跳到完成
On Error GoTo 100
Dim file As String
Dim basePath As String
Dim val
basePath = InputBox("请输入路径")
If basePath = "" Then
MsgBox "请输入路径"
Exit Sub
End If
val = InputBox("请输入你要修改成的值")
'忽略修改警告
Application.DisplayAlerts = False
'查找某路径下面所有的txt文档并弹出文件名
file = Dir("C:\Users\星驰太帅了\Desktop\excel\*.xlsx")
a = SetValue(basePath, file, val)
Debug.Print "根文件下面的文件 " & file
'如果文件名不为空代表还有文件,那么就一直循环
Do While file <> ""
'第二次不需要再填写路径,要不然会造成死循环
file = Dir
'再判断一下,免得当为空时还做了操作
If file = "" Then Exit Do
a = SetValue(basePath, file, val)
Debug.Print "根文件下面的文件 " & file
Loop
'结束语提示
Debug.Print "end"
'重新开启警告
Application.DisplayAlerts = True
100:
MsgBox "修改完成"
End Sub
Function SetValue(basePath, worksPath, value)
Dim rowCount
Dim c As Range
filePath = basePath & worksPath
With Workbooks.Open(filePath)
'第一列最后一行
rowCount = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).row
For Each c In Range("a1:a" & rowCount)
If c.value = "编制日期:" Then
.Sheets(1).Cells(c.row, 2).value = value
Exit For
End If
Next
.Save '修改完需要保存文件
.Close
End With
End Function
可以用find 函数更容易,如下
Function SetValue(basePath, worksPath, value)
Dim c As Range
Dim rowCount As Range
filePath = basePath & worksPath
With Workbooks.Open(filePath)
'第一列最后一行
Set rowCount = .Sheets(1).Cells.Find("编制日期:", , xlFormulas, , , xlPrevious)
.Sheets(1).Cells(rowCount.row, 2).value = value
.Save '修改完需要保存文件
.Close
End With
End Function