网站 › 『编程语言讨论求助区』 › 不打开表格 批量替换单元格中的数据，求VBA代码

zhenghm1104 发表于 2023-7-16 21:42

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

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

wyw6813 发表于 2023-7-16 22:07

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 发表于 2023-7-16 22:15

本帖最后由 Caraciold_Jr 于 2023-7-16 22:42 编辑

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 发表于 2023-7-16 22:17

不错，看看一下

浪漫的老板 发表于 2023-7-16 22:23

学习学习！！！

罗萨 发表于 2023-7-16 22:29

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 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

江河宁夏 发表于 2023-7-17 07:13

这有些高难度

WAfslove 发表于 2023-7-17 07:22

学习一下，有用

wjbg2022 发表于 2023-7-17 07:57

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

haduke 发表于 2023-7-17 08:16

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

查看完整版本: 不打开表格 批量替换单元格中的数据，求VBA代码