Определить порядковые номера первой пары соседних символов

Private Sub CommandButton1_Click()
Dim s As String, d() As String, k As Integer, z As Integer
s = Cells(1, 1) ' 9+2+7-4
r = Len(s)
ReDim d(r)
z = 1
d(1) = Mid(s, 1, 1)
Cells(z + 1, 3) = "Циры в выражении"
Cells(z + 2, 3) = d(z)
For i = 2 To r Step 2
z = z + 1
d(z) = Mid(s, i, 2)
Cells(z + 2, 3) = d(z)
Next
For i = 1 To z
k = k + CInt(d(i))
Next
Cells(z + 3, 3) = "Сумма = " & k
End Sub

Private Sub CommandButton1_Click()
Dim s As String, d() As String, k As Integer
s = Cells(1, 1)
r = Len(s)
ReDim d(r)
For i = 1 To r
d(i) = Mid(s, i, 1)
Cells(i + 2, 1) = d(i)
Next
For i = 1 To r - 1
If d(i) = d(i + 1) Then
k = i
f = "Порядковые номера первой пары одинаковых соседних символов " & k & " и " & k + 1
Exit For
End If
Next
If k = 0 Then
f = "пары одинаковых соседних символов - нет"
End If
Cells(2, 3) = f
End Sub

MsgBox ActiveDocument.Range.Calculate

'1.
Sub dd()
Dim a, b
If Application.Name Like "*Excel*" Then Set a = Application Else _
    Set a = CreateObject("excel.application"): b = True
MsgBox a.Evaluate(InputBox("Введите выражение", , "12+34-678"))
If b Then a.Quit
End Sub
 
'2.
Sub ff()
With CreateObject("vbscript.regexp")
    .Pattern = "(\S)\1"
    With .Execute(InputBox("Введите предложение", , "новая   коллизия"))
        If .Count Then
            MsgBox "Символы '" & .Item(0) & "', позиции " & .Item(0).firstindex + 1 & ", " & .Item(0).firstindex + 2
        Else
            MsgBox "Нет одинаковых соседних символов"
        End If
    End With
End With
End Sub

Public Sub a()
s = "Íà êîëîñcàëüíîé äîùàòîé òåððàñå, âáëèçè ìîææåâåëüíèêà, æåíà íåáåçûçâåñòíîãî ìåñòíîãî ïîäüÿ÷åãî âåñíóø÷àòàÿ Àãðàôåíà Ñàââè÷íà ïîò÷åâàëà èñïîäòèøêà êîëëåæñêîãî àñåññîðà, Àïîëëîíà Ôèëèìîíîâè÷à, ìîëëþñêàìè è âèíåãðåòîì ïîä àêêîìïàíåìåíò àêêîðäåîíà è âèîëîí÷åëè."
    Set reg = CreateObject("vbscript.regexp")
    reg.Pattern = "(.*?)?(.)\2"
    Set mtchs = reg.Execute(s)
    If mtchs.Count = 0 Then: MsgBox "íåò ïîâòîðÿþùèõñÿ ñèìâîëîâ": Exit Sub
    MsgBox ("ñîâïàäàþùàÿ ïàðà â ïîçèöèè " & mtchs(0).Length - 1)
End Sub

Public Sub b()
s = "12+34-678"
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = "([+-])?(\d*)"
    Set mtchs = reg.Execute(s)
    For Each m In mtchs
        d = d + IIf(m.submatches(0) < "-", CDbl(0 & m.submatches(1)), CDbl(0 & m.submatches(1)) * -1)
    Next
    MsgBox d
End Sub