我想用VB实现同时替换多个字符串,注意是数万个字符批量替换! 使用replace只能做到一次替换一个字符串
比如,我有字符串"我亲爱的老公看你的",我想把"我"替换成"你",把"你"替换成"我",如果用replace做的话,按照上面的顺序得到的结果是"我亲爱的老公看我的",而我...
比如,我有字符串"我亲爱的老公看你的" ,我想把"我"替换成"你",把"你"替换成"我",如果用replace做的话,按照上面的顺序得到的结果是"我亲爱的老公看我的",而我实际上想要的效果是"你亲爱的老公看我的",明白了吗?
希望能给出具体的函数,我可以直接套用的!!我已经把需要替换的字符都放在一个文本文件中,用VB读取写入一个数组中了!
我只是举个简单的比方,几万个字符啊,是需要具体的函数来实现的 展开
希望能给出具体的函数,我可以直接套用的!!我已经把需要替换的字符都放在一个文本文件中,用VB读取写入一个数组中了!
我只是举个简单的比方,几万个字符啊,是需要具体的函数来实现的 展开
10个回答
展开全部
先把我替换成一个特殊的字符比如X
再把你替换成我 最后把特殊字符 X替换成你
要VBA 么 替换就OK 了啊
估计LZ 是有好多组数据 批量替换 都写在单元格里面了把
Sub tt()
Dim a, b
a = Cells(1, 2)
b = Cells(1, 3)
For Each cell In ActiveSheet.Range("A1:A100")
cell.Value = Replace(cell.Value, a, "X")
cell.Value = Replace(cell.Value, b, a)
cell.Value = Replace(cell.Value, "X", b)
Next
End Sub
我这个比较简单的 我估计你是要用[B1 C1]替换A1 ,B2 C2 替换A2 这样的吧 有没理解错啊?
方便附件G21-YANG@163.COM 来看看什么个情况啊
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
直接字符串替换不就行了?
我亲爱的老公看你的=你亲爱的老公看我的
你非要分开来做
Private Sub Command1_Click()
Text1.Text = TtoT("---------1我亲爱的老公看你的2-------", "我亲爱的老公看你的", "我", "你")
'结果---------1你亲爱的老公看我的2-------
End Sub
'要处理的文本 符合条件的段 要替换的内容A 要替换的内容B
Private Function TtoT(ByVal txt As String, ByVal s As String, ByVal a As String, ByVal b As String) As String
If InStr(1, txt, s) <> 0 Then
'标识 "关键文本出现位置"
Dim n As Long
n = InStr(1, txt, s)
Dim l As Long
l = Len(s)
For i = n To n + l-1
Select Case Mid(txt, i, 1)
Case a
Mid(txt, i, 1) = b
Case b
Mid(txt, i, 1) = a
End Select
Next i
End If
TtoT = txt
End Function
我亲爱的老公看你的=你亲爱的老公看我的
你非要分开来做
Private Sub Command1_Click()
Text1.Text = TtoT("---------1我亲爱的老公看你的2-------", "我亲爱的老公看你的", "我", "你")
'结果---------1你亲爱的老公看我的2-------
End Sub
'要处理的文本 符合条件的段 要替换的内容A 要替换的内容B
Private Function TtoT(ByVal txt As String, ByVal s As String, ByVal a As String, ByVal b As String) As String
If InStr(1, txt, s) <> 0 Then
'标识 "关键文本出现位置"
Dim n As Long
n = InStr(1, txt, s)
Dim l As Long
l = Len(s)
For i = n To n + l-1
Select Case Mid(txt, i, 1)
Case a
Mid(txt, i, 1) = b
Case b
Mid(txt, i, 1) = a
End Select
Next i
End If
TtoT = txt
End Function
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
'强力RePlace,用法与RePlace一样,可同时替换多个内容(数组),注意sFind数组与sReplace数组要一一对应
'返回替换后的字符串
'cuidong@vip.163.com
Private Function SupperRePlace(sExpression As String, sFind() As String, sReplace() As String, Optional ByVal tCompare As VbCompareMethod = vbBinaryCompare) As String
Dim i As Long
Dim iIndex As Long
Dim iLen As Long
Dim iPos As Long
Dim iFind As Long
Dim iFindTest As Long
Dim sReturn As String
On Error GoTo ErrEvent
If sExpression = vbNullString Then GoTo ErrEvent
If LBound(sFind) <> LBound(sReplace) Then GoTo ErrEvent
If UBound(sFind) <> UBound(sReplace) Then GoTo ErrEvent
iPos = 1
iLen = Len(sExpression)
sReturn = vbNullString
Do
iFind = iLen + 1
For i = LBound(sFind) To UBound(sFind)
If sFind(i) <> vbNullString Then
iFindTest = InStr(iPos, sExpression, sFind(i), tCompare)
If iFindTest > 0 And iFindTest < iFind Then
iFind = iFindTest
iIndex = i
End If
End If
Next i
If iFind > iLen Then Exit Do
sReturn = sReturn & VBA.Mid(sExpression, iPos, iFind - iPos)
sReturn = sReturn & sReplace(iIndex)
iPos = iFind + Len(sFind(iIndex))
Loop
sReturn = sReturn & VBA.Mid(sExpression, iPos, iLen - iPos + 1)
SupperRePlace = sReturn
ErrEvent:
End Function
'返回替换后的字符串
'cuidong@vip.163.com
Private Function SupperRePlace(sExpression As String, sFind() As String, sReplace() As String, Optional ByVal tCompare As VbCompareMethod = vbBinaryCompare) As String
Dim i As Long
Dim iIndex As Long
Dim iLen As Long
Dim iPos As Long
Dim iFind As Long
Dim iFindTest As Long
Dim sReturn As String
On Error GoTo ErrEvent
If sExpression = vbNullString Then GoTo ErrEvent
If LBound(sFind) <> LBound(sReplace) Then GoTo ErrEvent
If UBound(sFind) <> UBound(sReplace) Then GoTo ErrEvent
iPos = 1
iLen = Len(sExpression)
sReturn = vbNullString
Do
iFind = iLen + 1
For i = LBound(sFind) To UBound(sFind)
If sFind(i) <> vbNullString Then
iFindTest = InStr(iPos, sExpression, sFind(i), tCompare)
If iFindTest > 0 And iFindTest < iFind Then
iFind = iFindTest
iIndex = i
End If
End If
Next i
If iFind > iLen Then Exit Do
sReturn = sReturn & VBA.Mid(sExpression, iPos, iFind - iPos)
sReturn = sReturn & sReplace(iIndex)
iPos = iFind + Len(sFind(iIndex))
Loop
sReturn = sReturn & VBA.Mid(sExpression, iPos, iLen - iPos + 1)
SupperRePlace = sReturn
ErrEvent:
End Function
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
其实很简单。用replace就可以实现。
即在你的关键词替换词库中设置三行:
A→C
B→A
C→B
就可以实现你想要的功能了。
即在你的关键词替换词库中设置三行:
A→C
B→A
C→B
就可以实现你想要的功能了。
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
既要完成批量替换,又要做到新替换的字符串不被替换,用replace是无法完成的。
楼上几位朋友提供的代码,虽可解决具体问题,但通用性不强,对于随机字符串的替换无法做到。
下面给出强大的批量替换代码,可完美解决上述问题:
一、替换文件编写规则:
每行表示一个替换,用=号分开,左表示替换前字符,右表示替换后字符。例:
我=你
你=我
二、通用函数(请放在一个模块中)
Function Replace_Ex(StrTxt As String, FileName As String) As String
Dim re, Found, founditems
Dim i, j, S1 As String, S2 As String
Dim a() As String, b() As String, bb() As Byte
'获取文件内容到变量a,S1
If Dir(FileName) = "" Then Exit Function
i = FreeFile
ReDim bb(FileLen(FileName) - 1)
Open FileName For Binary As #i
Get #i, , bb
Close #i
S1 = Trim(StrConv(bb, vbUnicode)) '读文件至变量
Erase bb
S1 = Trim(S1)
If S1 = "" Then Exit Function
a = Split(S1, vbNewLine)
S1 = "": S2 = ""
For i = 0 To UBound(a)
b = Split(Trim(a(i)), "=")
If UBound(b) = 1 Then
S1 = S1 & Trim(b(0)) & "|"
S2 = S2 & Trim(b(1)) & "|"
End If
Next
If S1 = "" Or S2 = "" Then Exit Function
S1 = Left(S1, Len(S1) - 1)
S2 = Left(S2, Len(S2) - 1)
a = Split(S1, "|")
b = Split(S2, "|")
'查找与替换
Set re = CreateObject("VBScript.RegExp") ' &&建立正则表达式对象
re.IgnoreCase = True '忽略大小写
re.Global = True '全局查找
re.Pattern = S1 '过滤条件
i = 0
S1 = "": S2 = ""
Set founditems = re.Execute(StrTxt)
For Each Found In founditems
DoEvents
If Found <> "" Then
For j = 0 To UBound(a) '查找替换的值
If a(j) = Found Then Exit For
Next
If j > UBound(a) Then Exit Function
StrTxt = Left(StrTxt, Found.firstindex + i) & b(j) & Mid(StrTxt, Found.firstindex + Found.length + 1 + i) '替换
i = i + Len(b(j)) - Found.length
End If
Next
Set Found = Nothing
Set founditems = Nothing
Set re = Nothing
Replace_Ex = StrTxt
End Function
三、调用举例:
假如原字符串是"我亲爱的老公看你的", 替换文件名为1.txt(内容如上例),那么可这样调用:
MsgBox Replace_Ex("我亲爱的老公看你的","1.txt")
返回值:你亲爱的老公看我的
楼上几位朋友提供的代码,虽可解决具体问题,但通用性不强,对于随机字符串的替换无法做到。
下面给出强大的批量替换代码,可完美解决上述问题:
一、替换文件编写规则:
每行表示一个替换,用=号分开,左表示替换前字符,右表示替换后字符。例:
我=你
你=我
二、通用函数(请放在一个模块中)
Function Replace_Ex(StrTxt As String, FileName As String) As String
Dim re, Found, founditems
Dim i, j, S1 As String, S2 As String
Dim a() As String, b() As String, bb() As Byte
'获取文件内容到变量a,S1
If Dir(FileName) = "" Then Exit Function
i = FreeFile
ReDim bb(FileLen(FileName) - 1)
Open FileName For Binary As #i
Get #i, , bb
Close #i
S1 = Trim(StrConv(bb, vbUnicode)) '读文件至变量
Erase bb
S1 = Trim(S1)
If S1 = "" Then Exit Function
a = Split(S1, vbNewLine)
S1 = "": S2 = ""
For i = 0 To UBound(a)
b = Split(Trim(a(i)), "=")
If UBound(b) = 1 Then
S1 = S1 & Trim(b(0)) & "|"
S2 = S2 & Trim(b(1)) & "|"
End If
Next
If S1 = "" Or S2 = "" Then Exit Function
S1 = Left(S1, Len(S1) - 1)
S2 = Left(S2, Len(S2) - 1)
a = Split(S1, "|")
b = Split(S2, "|")
'查找与替换
Set re = CreateObject("VBScript.RegExp") ' &&建立正则表达式对象
re.IgnoreCase = True '忽略大小写
re.Global = True '全局查找
re.Pattern = S1 '过滤条件
i = 0
S1 = "": S2 = ""
Set founditems = re.Execute(StrTxt)
For Each Found In founditems
DoEvents
If Found <> "" Then
For j = 0 To UBound(a) '查找替换的值
If a(j) = Found Then Exit For
Next
If j > UBound(a) Then Exit Function
StrTxt = Left(StrTxt, Found.firstindex + i) & b(j) & Mid(StrTxt, Found.firstindex + Found.length + 1 + i) '替换
i = i + Len(b(j)) - Found.length
End If
Next
Set Found = Nothing
Set founditems = Nothing
Set re = Nothing
Replace_Ex = StrTxt
End Function
三、调用举例:
假如原字符串是"我亲爱的老公看你的", 替换文件名为1.txt(内容如上例),那么可这样调用:
MsgBox Replace_Ex("我亲爱的老公看你的","1.txt")
返回值:你亲爱的老公看我的
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |