Excel vba 批量修改指定路径下指定名称对应的值

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