AW: Gleiche Zeichen
10.11.2014 15:03:51
ChrisL
Hi Alifa
Hier noch eine ähnliche Lösung
Sub Vergleich()
MsgBox AnzahlBuchstaben("QUELLTEXT", "GLUTHITZE")
End Sub
Function AnzahlBuchstaben(sWort1 As String, sWort2 As String) As Integer
Dim ar(1, 25)
Dim i As Integer
' in Array einlesen
For i = 1 To Len(sWort1)
ar(0, Asc(UCase(Mid(sWort1, i, 1))) - 65) = ar(0, Asc(UCase(Mid(sWort1, i, 1))) - 65) + 1
Next i
For i = 1 To Len(sWort2)
ar(1, Asc(UCase(Mid(sWort2, i, 1))) - 65) = ar(1, Asc(UCase(Mid(sWort2, i, 1))) - 65) + 1
Next i
' Array vergleichen, Ergebnis ermitteln
For i = 0 To 25
If ar(0, i) > 0 And ar(1, i) > 0 Then
If ar(0, i) > ar(1, i) Then
AnzahlBuchstaben = AnzahlBuchstaben + ar(1, i)
Else
AnzahlBuchstaben = AnzahlBuchstaben + ar(0, i)
End If
End If
Next i
End Function
cu
Chris