vba 使txt中英文中间加空格并对齐

198801273815

达到图片中的效果

简七

正则(?<![一-龢])(?=[一-龢])

198801273815

简七 发表于 2020-11-29 00:42
正则(?

能写下代码吗？

简七

Sub test()
Dim ado As Object
Dim reg As Object
Dim p$, s$, rs$, f$
p = Dir(ThisWorkbook.Path & "\*.txt") '文本文件目录
Set ado = CreateObject("adodb.stream") 'ado
Set reg = CreateObject("VBscript.regexp") '正则

With reg
.MultiLine = True '多行
.Global = True '全部
.ignorecase = True '不区分大小写
.Pattern = "([一-龢]+)" '表达式
End With

With ado
.Charset = "GB2312" '编码
.Type = 2 '打开类型

End With


While p <> ""
f = ThisWorkbook.Path & "\" & p
With ado
.Open '打开ado
.LoadFromFile f '载入文件
s = .ReadText '读文本
End With

rs = reg.Replace(s, Chr(9) & "$1") '正则替换并将值赋给变量
ado.Close '关闭ado
Kill f '删除原文件

ado.Open
ado.WriteText rs '写入修改后文本
ado.SaveToFile f '保存文件
ado.Close
p = Dir
Wend
Set ado = Nothing
Set reg = Nothing
End Sub

简七

中间判定一下字符串长度是否小于8 ＜8要在加对应制表符 因为字符长度大于等于8制表符长度会再增加8个位置

简七

Sub test()
Dim ado As Object
Dim reg As Object
Dim p$, s$, rs$, f$, sarr, i%, maxlength, slength, slength2
p = Dir(ThisWorkbook.Path & "\*.txt") '文本文件目录
Set ado = CreateObject("adodb.stream") 'ado
Set reg = CreateObject("VBscript.regexp") '正则

With reg
.MultiLine = True '多行
.Global = True '全部
.ignorecase = True '不区分大小写
.Pattern = "([一-龢]+)" '表达式
End With

With ado
.Charset = "GB2312" '编码
.Type = 2 '打开类型

End With


While p <> ""
rs = "" '写入文本置空
f = ThisWorkbook.Path & "\" & p '文件路径
With ado
.Open '打开ado
.LoadFromFile f '载入文件
s = .ReadText '读文本
End With
sarr = Split(s, vbNewLine) '读入文本转换为数组
maxlength = 0 '字符串最大长度置0
For i = LBound(sarr) To UBound(sarr) '计算每行字符串最大长度
If maxlength < Len(reg.Replace(sarr(i), "")) Then maxlength = Len(reg.Replace(sarr(i), "")) '逐行对比字符串长度,对maxlength赋值
Next

For i = LBound(sarr) To UBound(sarr)
If Len(reg.Replace(sarr(i), "")) < 8 Then '字符数小于8加入最大字符串/8,不足1向上进位1个制表符,等于或超过8个字符,制表符会向后再移动8个字符,显示会不对齐
    slength = Application.Ceiling(maxlength / 8, 1) '插入制表符个数计算
    rs = rs & reg.Replace(sarr(i), String(slength, Chr(9)) & "$1") & vbNewLine '连接文本
ElseIf Len(reg.Replace(sarr(i), "")) < maxlength Then '大于8小于最大长度字符串,计算与最大长度相差值/8,不足1向上进位1
    slength2 = Application.Ceiling((maxlength - Len(reg.Replace(sarr(i), ""))) / 8, 1) '插入制表符个数计算
    rs = rs & reg.Replace(sarr(i), String(slength2, Chr(9)) & "$1") & vbNewLine '连接文本
Else
    rs = rs & reg.Replace(sarr(i), Chr(9) & "$1") & vbNewLine '连接文本
End If
Next
ado.Close '关闭ado,直接写入会保存原来值
Kill f '删除原文件,不知道怎么在原文件改

ado.Open '重新打开ado
ado.WriteText rs '写入修改后文本
ado.SaveToFile f '保存文件到原路径
ado.Close
p = Dir '调用下一个
Wend
Set ado = Nothing '释放内存
Set reg = Nothing '释放内存
End Sub

198801273815

简七 发表于 2020-11-30 09:56
Sub test()
Dim ado As Object
Dim reg As Object

感谢帮助，很好的实现了我的想法