查找并连接出现多次的字符

我只是在这里看到可能的答案，但找不到一个。 我的问题是，我想find出现在一个单词/短语一次以上的字符。

例如：

如果我inputFaseehh结果应该是e,h
如果我inputFawwd结果应该是w
如果我inputFaroq结果应该是-

我开发了follwing代码，但这是给我值的错误。

 Function CountRept(textt As String) Dim i As Integer Dim temp As String Dim aLetter As String temp = StrConv(textt, vbUnicode) temp = Left(temp, Len(temp) - 1) aLetter = Split(temp, Chr(0)) For i = 1 To Len(textt) If worksheetfunctions.CountIf(aLetter, Mid(textt, i, 1)) > 1 Then textt = textt & "," & Mid(textt, i, 1) End If Next i CountRept = textt & "," & Mid(textt, i, 1) End Function 

我的意图是将string分解为单个字符，然后使用Mid（）和concatenate进行比较。 任何帮助和解释是高度赞赏。 谢谢

Answer 1

尝试这个：

 Function CountRep(str As String) As String Dim strArr As Variant, repStr As Variant, Dim i As Long '~~> The For Loop is to evaluate each letter of the word or phrase For i = 1 To Len(str) '~~> First 2 Nested If's is to generate the unique values If Not IsArray(strArr) Then strArr = Array(Mid$(str, i, 1)) Else If IsError(Application.Match(Mid$(str, i, 1), strArr, 0)) Then ReDim Preserve strArr(UBound(strArr) + 1) strArr(UBound(strArr)) = Mid$(str, i, 1) Else '~~> Second Nested If's is to generate the unique repeated values If Not IsArray(repStr) Then repStr = Array(Mid$(str, i, 1)) Else If IsError(Application.Match(Mid$(str, i, 1), repStr, 0)) Then ReDim Preserve repStr(UBound(repStr) + 1) repStr(UBound(repStr)) = Mid$(str, i, 1) End If End If End If End If Next '~~> Check if there are repeated values, if none exit If IsEmpty(repStr) Then CountRep = "-": Exit Function '~~> Write the output For i = LBound(repStr) To UBound(repStr) If Len(CountRep) = 0 Then CountRep = repStr(i) Else CountRep = CountRep & "," & repStr(i) End If Next End Function 

基本上，我们只是使用一个例程来获得两次独特的值。
第一是获得实际的唯一值，第二是获得独特的重复值。
我们使用内置的Application.Match函数来过滤出唯一的事件。
我们使用Variant数据types，所以我们可以像IsArray和IsEmpty一样应用内置的逻辑testing。

Answer 2

我不知道你是否只是在寻找相邻的字符。 下面的代码会查找所有重复的string，相邻或不相邻。 如果使用不区分大小写的search，示例string将返回“o”或“g，o”：

 Function countRep(str as String) 'str = lcase(str) '--if you want case-insensitive search Dim msg As String, curr As String Dim i As Integer, k As Integer 'Make Array as large as the string Dim letters() As String ReDim letters(Len(str)) 'Loop through letters of string For i = 1 To Len(str) curr = Mid(str, i, 1) 'Loop through the array for checks For k = 1 To i 'Add letter to message if not already included If letters(k) = curr And 0 = InStr(msg, curr) Then msg = msg & curr & "," Next k 'Add letter to array for future checks letters(i) = curr Next i 'Remove trailing comma countRep = Left(msg, Len(msg) - 1) End Function 

如果你只想要相邻的字符，你可以跳过数组的使用，只保存最后一个字母检查，以便与下面的比较。