VBA遍历文件夹下所有文件，替换内容，保存关闭 - 淅淅的个人空间

link之家

链接快照平台

输入网页链接，自动生成快照
标签化管理网页链接

相关文章推荐

正直的芹菜 · wps vba6.3 ...· 3 周前 ·

爱健身的电脑桌 · 农业部推介全国农村创业创新优秀带头人典型案例· 4 月前 ·

刚毅的企鹅 · 哥布林巢穴第一话巡礼者_哔哩哔哩_bilibili· 4 月前 ·

热情的便当 · 漫画全集在线观看 - 哔哩哔哩漫画· 1 年前 ·

旅行中的砖头 · 为什么那么多菲律宾人在海外从事家政服务行业， ...· 1 年前 ·

微笑的红烧肉 · “屎”里逃生第一虫——被吃不怕，给它几小时， ...· 1 年前 ·

今天使用vba来实现了一个小功能，批量修改此文件所在文件夹下的所有其他Excel文件中的B列，在B列中使用一组字符来替换另一组字符，如下图。举例说明，如果字符中含有“弹药”则替换成“玩具”。

控制台页如下图，其中按钮“品名替换”指定的宏名是“品名替换工具.xlsm!宏1”：

代码如下：

Sub 宏1()
' 宏1 宏
'清空日志输出单元格
ThisWorkbook.Sheets("控制台").Cells(2, 1) = ""
Application.ScreenUpdating = False           '关闭屏幕刷新
Application.DisplayAlerts = False            '禁用所有事件
'需要替换品名的文件
Dim targetWB As Workbook
'处理的文件数量
Dim fileNumber As Integer
fileNumber = 0
'处理的文件名
Dim fileNames As String
'有按钮的文件
Dim consoleWB As Workbook
'有按钮的文件所在的目录，默认需要替换品名的文件也在此目录
Dim path As String
Set consoleWB = ThisWorkbook
path = consoleWB.path
 myfile = Dir(path & "\*.xls*")     '遍历当前文件夹下的Excel文件
Do While myfile <> ""                '当找到的文件不为空时
    If myfile <> ThisWorkbook.Name Then   '当找到的文件不是当前Excel工作簿时
        'Debug.Print myfile
        showProcessingLog ("正在处理：" + myfile)
        fileNumber = fileNumber + 1
        fileNames = fileNames + vbCrLf + myfile
        Set targetWB = Application.Workbooks.Open(ThisWorkbook.path & "\" & myfile)
        Set targetST = targetWB.Sheets("Detail")
        '遍历需要替换的品名列表
        Dim i As Integer
        For i = 2 To consoleWB.Sheets("品名替换").UsedRange.Rows.Count
           If consoleWB.Sheets("品名替换").Cells(i, 1) = "" Then Exit For
              targetWB.Sheets("Detail").Columns("B:B").Select
            x = replaceInColumn(targetWB.Sheets("Detail").Columns("B:B"), consoleWB.Sheets("品名替换").Cells(i, 1), consoleWB.Sheets("品名替换").Cells(i, 2))
         '保存打开的工作簿
        targetWB.Save
         '关闭打开的工作簿
        targetWB.Close
        showProcessingLog ("处理完成：" + myfile)
    End If
    myfile = Dir          '寻找下一个Excel工作簿
'打开屏幕刷新
Application.ScreenUpdating = True
mm = MsgBox("一共处理了" & fileNumber & "文件，分别是：" + fileNames, vbOKOnly, "处理结果")
End Sub
'将某一个区域出现的source替换成target
Function replaceInColumn(area, source, target)
    Selection.replace What:=source, Replacement:=target, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Function
Function showProcessingLog(msg)
'打开屏幕刷新
Application.ScreenUpdating = True
 ThisWorkbook.Sheets("控制台").Cells(2, 1) = ThisWorkbook.Sheets("控制台").Cells(2, 1) + vbCrLf + msg
'关闭屏幕刷新
Application.ScreenUpdating = False
End Function