骑马与砍杀中文站论坛

 找回密码
 注册(Register!)

QQ登录

只需一步,快速开始

搜索
购买CDKEY 小黑盒加速器
查看: 4626|回复: 3

[讨论] 写了个批量替换txt的vba代码

[复制链接]

14

主题

59

回帖

27

积分

随仆

Rank: 1

UID
3279850
第纳尔
379
精华
0
互助
1
荣誉
0
贡献
0
魅力
0
注册时间
2021-10-17
鲜花(3) 鸡蛋(0)
发表于 2021-10-29 00:50:32 来自手机 | 显示全部楼层 |阅读模式
网上的程序又贵又不敢用,还是自己编译好用,我要免费发出来有要的吗
来自: Android客户端

54

主题

899

回帖

341

积分

见习骑士

游骑士战队[YQS]
联机ID:Apple_PAI

Rank: 3

UID
3218444
第纳尔
106
精华
0
互助
11
荣誉
0
贡献
0
魅力
26
注册时间
2021-1-30

战团正版勋章2022国庆青训杯冠军勋章第一届拿破仑中国刺刀联赛近卫勋章霸主正版勋章拿破仑正版勋章

鲜花(110) 鸡蛋(0)
发表于 2021-10-30 13:16:56 | 显示全部楼层
管他呢,发出来在说
苹果派真好吃嘿嘿嘿

14

主题

40

回帖

26

积分

随仆

Rank: 1

UID
3280159
第纳尔
306
精华
0
互助
2
荣誉
0
贡献
0
魅力
25
注册时间
2021-10-18
鲜花(2) 鸡蛋(0)
发表于 2021-10-30 15:11:47 | 显示全部楼层
本帖最后由 var7 于 2021-10-30 15:13 编辑

Dim arrFiles() As String
Dim countFiles%
Sub 替换文件内容()
    Dim strPath$
    Dim i%
    Dim fso As New FileSystemObject, fd As Folder
    '遍历文件夹
    strPath = "C:\Users\Administrator\Desktop\操作台\替换区\"
    ReDim arrFiles(0 To 999)
    countFiles = 0
    Set fd = fso.GetFolder(strPath)
    SearchFiles fd
    arrFiles = Filter(arrFiles, ".txt", True, vbTextCompare)
    '替换每一个文件
    For i = 0 To UBound(arrFiles)
        Set txt = fso.OpenTextFile(arrFiles(i), 1, False)
        stri = txt.ReadAll
        txt.Close
        Set txt = Nothing
        '批量替换
        For num = 1 To 65536
            'If Cells(num, 1) <> "" And IsNumeric(Cells(num, 1)) Then
            If Cells(num, 1) <> "" Then
                stri = replace(stri, Cells(num, 1), Cells(num, 2))
            Else
                Exit For
            End If
        Next num
        Set txt = fso.OpenTextFile(arrFiles(i), 2, True)
        txt.Write (stri)
        txt.Close
        Set txt = Nothing
        Set fs = Nothing
        'MsgBox arrFiles(i) & "文件替换停止在规则的第" & num & "行"
    Next i
    MsgBox "文件替换停止在规则的第" & num & "行"
''输出改写数据
'    MsgBox UBound(arrFiles) + 1
'    For i = 0 To UBound(arrFiles)
'        MsgBox arrFiles(i)
'    Next i
End Sub

Sub SearchFiles(ByVal fd As Folder)
     Dim fl As File
     Dim sfd As Folder

     For Each fl In fd.files
        If countFiles > UBound(arrFiles) Then ReDim Preserve arrFiles(0 To countFiles + 999)
        arrFiles(countFiles) = fl
        countFiles = countFiles + 1
    Next fl
End Sub

替换区.zip

1.71 MB, 下载次数: 81

14

主题

40

回帖

26

积分

随仆

Rank: 1

UID
3280159
第纳尔
306
精华
0
互助
2
荣誉
0
贡献
0
魅力
25
注册时间
2021-10-18
鲜花(2) 鸡蛋(0)
发表于 2021-10-30 15:14:45 | 显示全部楼层
var7 发表于 2021-10-30 15:11
Dim arrFiles() As String
Dim countFiles%
Sub 替换文件内容()

很简单,具体怎么用还用我说明吗?就是用来txt添加城堡用的
您需要登录后才可以回帖 登录 | 注册(Register!)

本版积分规则

Archiver|手机版|小黑屋|骑马与砍杀中文站

GMT+8, 2024-11-19 14:36 , Processed in 0.118916 second(s), 24 queries , Gzip On, MemCached On.

Powered by Discuz! X3.4 Licensed

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表