有这样一列文字，请看！

sakurako 2004-08-18 04:20:33

有这样一列文字，目的是求出其中的只出现一次的字的个数
例如:ss dd sd ss kj lk kj
返回值应该是 3
谁能写出这样的函数，分全给他(最优的)
最好用VB！！

...全文

142 16 打赏收藏转发到动态举报

写回复

用AI写文章

16 条回复

切换为时间正序

请发表友善的回复…

发表回复

rainstormmaster 2004-08-19

打赏
举报

呵呵：）

northwolves 2004-08-19

打赏
举报

rainstormmaster(暴风雨 v2.0)兄弟，多谢指教。

rainstormmaster 2004-08-19

打赏
举报

是的，我说的是比较极端的情况，不过我建议最好还是考虑一下这种情况，你说呢？

sakurako 2004-08-19

打赏
举报

呵呵，谢谢大家的帮助！结贴~

northwolves 2004-08-18

打赏
举报

to rainstormmaster(暴风雨 v2.0) :

你说得是极端情况。那么多"*"就不是句子了,可以换用其他罕见字符，如※☆№●¤⊙├㈡⑹ぃぁㄋш

rainstormmaster 2004-08-18

打赏
举报

to northwolves(狼行天下):
你和of123犯了同样的错误，假如：
Dim s As String
s = "* ** *** *** *******"
getonce s
你看会得到什么

northwolves 2004-08-18

打赏
举报

Private Sub Command1_Click()
MsgBox numonce("ss dd sd ss kj lk kj")
End Sub

Function numonce(ByVal s As String)
Dim temp() As String, i As Long
numonce = 0
s = "*" & Replace(s, " ", "* *") & "*"
temp = Split(s, " ")
For i = 0 To UBound(temp)
If UBound(Filter(temp, temp(i))) = 0 Then numonce = numonce + 1
Next
Erase temp
End Function

加强：

Sub getonce(ByVal s As String, Optional ByRef num As Integer, Optional ByRef result As String)
Dim temp() As String, i As Long, temp2() As String
num = 0
s = "*" & Replace(s, " ", "* *") & "*"
temp = Split(s, " ")
For i = 0 To UBound(temp)
If UBound(Filter(temp, temp(i))) = 0 Then
num = num + 1
ReDim Preserve temp2(1 To num)
temp2(num) = Mid(temp(i), 2, Len(temp(i)) - 2)
End If
Next
result = Join(temp2, vbCrLf)
MsgBox "只出现一次的字的个数有 " & num & " 个：" & vbCrLf & result
Erase temp
Erase temp2
End Sub

Private Sub Command2_Click()
getonce "ss dd sd ss kj lk kj"
End Sub

route2 2004-08-18

打赏
举报

Private Sub Command1_Click()
Dim i, j As Integer '循环变量
Dim s As String '你的字符串
Dim aStr() As String '拆分你的字符串的数组
Dim ub As Integer '拆分得到的数组的数据个数
Dim zb As Boolean '正版标志
Dim ct As Integer '记录正版个数
Dim sout As String '输出正版集合，如果你要的话

s = "ss dd sd ss kj lk kj"
aStr = Split(s) '拆分
ub = UBound(aStr) '取得最大下标
sout = ""
ct = 0
For i = 0 To ub '排队检查
If Not aStr(i) = "" Then '如果已被刷掉就不查了
zb = True '姑且抱有一丝希望
For j = i + 1 To ub
If aStr(i) = aStr(j) Then
zb = False '完了，被盗版了
aStr(j) = "" '刷掉找到的盗版
End If
Next j
If zb = False Then
aStr(i) = "" '已被盗版，刷掉自己
Else
ct = ct + 1 '哟嗬，正版，难得，收藏先
sout = sout & " " & aStr(i)
End If
End If
Next i
Print ct & " word(s) stand alone:"
Print sout
End Sub

rainstormmaster 2004-08-18

打赏
举报

顺便说一下 of123()粗心了（当然他的代码处理楼主给出的字串还是可以的），比如说：
Dim s As String
s = "aa aaa aaaa aaaaa aaaaaaa"
MsgBox CStr(Exist_Once(s))

看看结果是什么

rainstormmaster 2004-08-18

打赏
举报

Option Explicit
'需要加入对Microsoft Scripting Runtime的引用
Private Sub Command1_Click()
Dim s As String
s = "ss dd sd ss kj lk kj"
Dim mDictionary As New Dictionary
Dim buff() As String
On Error Resume Next
buff = Split(s, " ")
Dim i As Long
For i = 0 To UBound(buff)
If mDictionary.Exists(buff(i)) Then
mDictionary.Item(buff(i)) = mDictionary.Item(buff(i)) + 1
Else
mDictionary.Add buff(i), 1
End If
Next
Dim mItems()
mItems = mDictionary.Items
Dim mKeys()
mKeys = mDictionary.Keys
Dim Result() As String
Dim n As Long
For i = 0 To UBound(mKeys)
If mItems(i) = 1 Then
ReDim Preserve Result(n)
Result(n) = mKeys(i)
n = n + 1
End If
Next

Debug.Print "指定字串中，只出现一次的单词有" + CStr(UBound(Result) + 1) + "个"
Debug.Print "它们是："
For i = 0 To UBound(Result)
Debug.Print Result(i)
Next
Debug.Print "报告完毕"
'收尾工作
Erase buff
Erase mItems
Erase mKeys
Erase Result
Set mDictionary = Nothing
End Sub

of123 2004-08-18

打赏
举报

Public Function Exist_Once(ByVal strText As String) As Integer
Dim i, L, n As Integer
Dim mystr, myword As String

If Right(strText, 1) > " " Then strText = strText & " "
mystr = strText
For i = 1 To Len(strText) Step 3
myword = Mid(strText, i, 3)
L = Len(mystr)
mystr = Replace(mystr, myword, "")
If L - Len(mystr) = Len(myword) Then n = n + 1
If Len(mystr) = 0 Then Exit For
Next i
Exist_Once = n
End Function

sakurako 2004-08-18