不打开表格 批量替换单元格中的数据，求VBA代码

zhenghm1104

各位大神，如图1，prog文件夹中有100多个表格，表格模式一样（如图2）A3格多是2023/2/1。问题:不打开excel表格的情况下，批量替换A3单元格中的数据，全部替换成2023/7/8。求VBA代码，谢谢

wyw6813

[Visual Basic] 纯文本查看 复制代码

Sub ModifyCellContent()
    ' 设置目录路径
    Dim folderPath As String
    folderPath = "D:\Prog\" '修改为你的目录路径
    
    ' 创建一个 Excel 应用例
    Dim excelApp As Object
    Set excelApp = CreateObject("Excel.Application")
    
    ' 遍历目录下的所有 .xlsx 文件
    Dim fileName As String
    fileName = Dir(folderPath & "*.xlsx")
    
    Do While Len(fileName) > 0
        ' 打开工作簿
        Dim workbook As Object
        Set workbook = excelApp.Workbooks.Open(folderPath & fileName)
        
        ' 获取第一个工作表
        Dim worksheet As Object
        Set worksheet = workbook.Worksheets(1)
        
        ' 修改单元格内容
        worksheet.Range("A3").Value = "2023/7/8"
        
        ' 保存工作簿
        workbook.Save
        
        ' 关闭工作簿
        workbook.Close
        
        ' 继续遍历下一个文件
        fileName = Dir
    Loop
    
    ' 关闭 Excel 应用程序
    excelApp.Quit
    
    ' 释放 Excel 对象
    Set excelApp = Nothing
End Sub

Caraciold_Jr

[Visual Basic] 纯文本查看 复制代码

Sub ReplaceA3InAllFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim targetCell As Range
    Dim newDate As Date
    
    ' 指定文件夹路径
    folderPath = "C:\path\to\your\prog\folder\"
    
    ' 设置新的日期值
    newDate = DateSerial(2023, 7, 8)
    
    ' 检查路径末尾是否有反斜杠
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' 获取文件夹中的第一个Excel文件名
    fileName = Dir(folderPath & "*.xls*")
    
    ' 遍历文件夹中的所有Excel文件
    Do While fileName <> ""
        ' 打开工作簿
        Set wb = Workbooks.Open(folderPath & fileName)
        
        ' 遍历工作簿中的所有工作表
        For Each ws In wb.Worksheets
            ' 设置目标单元格
            Set targetCell = ws.Range("A3")
            
            ' 替换目标单元格的数据
            targetCell.Value = newDate
        Next ws
        
        ' 保存并关闭工作簿
        wb.Close SaveChanges:=True
        
        ' 获取文件夹中的下一个Excel文件名
        fileName = Dir
    Loop
End Sub

Oldikeyo

不错，看看一下

浪漫的老板

学习学习！！！

罗萨

Set objFSO = CreateObject("Scripting.FileSystemObject") ' 创建文件系统对象
Set objExcel = CreateObject("Excel.Application") ' 创建 Excel 应用程序对象
objExcel.Visible = False ' 不显示 Excel 窗口

' 获取当前目录下的所有 Excel 文件
Set objFolder = objFSO.GetFolder(".")
For Each objFile In objFolder.Files
    If LCase(objFSO.GetExtensionName(objFile.Path)) = "xls" Or LCase(objFSO.GetExtensionName(objFile.Path)) = "xlsx" Then
        
        ' 构建连接字符串
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & objFile.Path & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=1;'"
        
        ' 建立连接
        Set objConn = CreateObject("ADODB.Connection")
        objConn.Open strConn
        
        ' 执行更新语句，替换指定单元格内容（F2为格子位置）
        strSQL = "UPDATE [Sheet1$] SET F2='替换后的内容'"
        objConn.Execute strSQL
        
        ' 关闭连接
        objConn.Close
    End If
Next

' 退出 Excel 应用程序
objExcel.Quit

' 释放对象
Set objConn = Nothing
Set objExcel = Nothing
Set objFolder = Nothing
Set objFSO = Nothing

江河宁夏

这有些高难度

WAfslove

学习一下，有用

wjbg2022

关闭屏幕刷新？真的可以不打开表格吗？

haduke

不打开估计不行，用第三方的组件，后台打开，100多个文件，也就1秒的事。