找到&连接出现多次的字符

时间:2014-05-27 05:29:09

标签: excel vba excel-vba

我只是在这里查看了可能的答案,但找不到答案。我的问题是,我想找到一个在单词/短语中出现多次的字符。

例如:

如果我输入Faseehh结果应为e,h
如果我输入Fawwd结果应为w
如果我输入Faroq结果应为-

我开发了以下代码,但这给了我价值错误。

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

我的目的是将字符串分解为单个字符,然后使用Mid()和concatenate进行比较。任何帮助和解释都非常感谢。感谢

2 个答案:

答案 0 :(得分:3)

我不确定你是否只在寻找相邻的角色。以下代码将在字符串中找到所有重复的字母,相邻或不相邻。示例字符串返回" 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

如果您只想要相邻的字符,可以跳过使用数组,只需保存最后一个字母,以便将其与以下内容进行比较。

答案 1 :(得分:2)

试试这个:

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 数据类型,因此我们可以应用内置的逻辑测试,如 IsArray和IsEmpty