Question

用vb怎样过滤掉文本中重复的数字和不是数字的内容?

想对http://zhidao.baidu.com/question/531951185的满意回答进行如下修改完善：在把重复的数字过滤掉的同时，把提取结果中不是数字的内容也过滤掉，可以么？比如：提取结果为：888 % 888 122 / ω 000 $?$ 678 *@＾@* 1516 ∩_∩ 122 abc123，那么，过滤掉重复的数字和不是数字的内容，最后结果为：888 122 000 678 1516。注意，如果数字和其他字符连写，作为非数字字符处理。

Answer 1

Option Explicit
Private Sub Command1_Click()
Dim arr, mark, dic, i
mark = "zhidao"
arr = "下：京(6699) 上海(4789) 美国(87968)……(6699)……当然并不(123)都是怎(456)样把"
arr = fc(arr, mark)
Set dic = CreateObject("scripting.dictionary")
For i = LBound(arr) To UBound(arr)
If Not dic.Exists(arr(i)) Then dic.Add arr(i), ""
Next
arr = dic.keys
Print Join(arr)
Open "c:\a.txt" For Output As #1
Print #1, Join(arr)
Close #1
Set dic = Nothing
End Sub
Function fc(s, mark)
Dim arr, brr(), i, n, str
If InStr(s, "(") > 0 Then
arr = Split(s, "(")
For i = 0 To UBound(arr)
If InStr(arr(i), ")") > 0 Then
str = Split(arr(i), ")")(0)
If IsNumeric(str) Then
ReDim Preserve brr(n)
brr(n) = Split(arr(i), ")")(0) & mark
n = n + 1
End If
End If
Next
End If
fc = brr
End Function

追问

不错。

追答

这是你前面一个问题的代码，我把2个功能写在一起了。你的源数据格式到底是怎么样的？

Answer 2

给个代码，作为一种思路
Dim i, j
Dim Arr
Dim IsCopy As Boolean '

'提取前的字串
S = "888 % 888 122 / ω 000 $?$ 678 *@＾@* 1516 ∩_∩ 122 abc123"
Arr = Split(S, " ") '用空格分离为数组
S2 = "" '提取后的字串

For i = 0 To UBound(Arr) - 1
If IsNumeric(Arr(i)) Then ' 如果该字符是数字
IsCopy = False '设定无重复
For j = i + 1 To UBound(Arr) - 1 '判断是否重复
If Arr(i) = Arr(j) Then
IsCopy = True '有重复
Exit For
End If
Next j
If IsCopy = False Then S2 = S2 & " " & Arr(i) '无重复记录该数字
End If
Next i
MsgBox S2

追问

可用，但希望做个更改，就是过滤结果每个数字后面加个一个相同的字符，比如：zhidao。如果过滤前内容为：888 % 888 122 / ω 000 $?$ 678 *@＾@* 1516 ∩_∩ 122 abc123，过滤后的结果应为：
888zhidao 122zhidao 000zhidao 678zhidao 1516zhidao
辛苦了，这个追问回答将加分。

追答

Dim i, j
Dim Arr
Dim IsCopy As Boolean '
Dim S1 as string, S2 as integer
Dim AddStr as string '定义要添加的字符

'提取前的字串
S = "888 % 888 122 / ω 000 $?$ 678 *@＾@* 1516 ∩_∩ 122 abc123"
Arr = Split(S, " ") '用空格分离为数组

AddStr="zhidao"
S2 = "" '提取后的字串

For i = 0 To UBound(Arr) - 1
If IsNumeric(Arr(i)) Then ' 如果该字符是数字
IsCopy = False '设定无重复
For j = i + 1 To UBound(Arr) - 1 '判断是否重复
If Arr(i) = Arr(j) Then
IsCopy = True '有重复
Exit For
End If
Next j
If IsCopy = False Then S2 = S2 & " " & Arr(i) & AddStr '无重复记录该数字
End If
Next i
MsgBox S2

追问

实时错误"13"
类型不匹配

追答

Dim S1 as string, S2 as string
不好意思，写错了，S1 S2 应该都为字符

Answer 3

到达= FC（ARR，马克）

插入一行低于
，REDIM保存ARR（UBOUND（ARR）* 0.3）