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

来源：互联网发布：mac上的小房子编辑：程序博客网时间：2024/05/22 12:41

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 = True100:    MsgBox "修改完成"End SubFunction 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 WithEnd 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 WithEnd Function

阅读全文

0 0