Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Gleiche Zeichen

Betrifft: Gleiche Zeichen von: Alifa
Geschrieben am: 10.11.2014 14:34:19

Hallo,
wie kann man dieses mit einem Makro lösen? Es sollen 2 verschiedene Worte geprüft werden, ob sie eine vorgegebene Anzahl gleicher Buchstaben enthalten. Beispiel: Wort1: QUELLTEXT. Wort 2:GLUTHITZE. Die Wortlänge ist gleich. Anzahl gleicher Buchstaben: 5. Das wäre WAHR. (L,U,T,T,E). Bei QUELLTEXT und DACHLATTE sind 4 gemeinsame Buchstaben(L,T,T,E). Danke im Voraus
Alifa

  

Betrifft: Was ist vorgegeben, nur die Anzahl oder auch ... von: Luc:-?
Geschrieben am: 10.11.2014 14:43:22

…die Buchstaben selbst, Alifa?
Gruß, Luc :-?

Besser informiert mit …


  

Betrifft: AW: Was ist vorgegeben, nur die Anzahl oder auch ... von: Alifa
Geschrieben am: 10.11.2014 15:49:40

Nur die Anzahl, die Buchstaben selbst sind nicht angegeben.
Gruß, Alifa


  

Betrifft: Ich hätte bei deinem 1.Bsp ja vermutet, dass ... von: Luc:-?
Geschrieben am: 11.11.2014 02:21:55

…es nur 4 gleiche Buchstaben sind, Alifa,
aber wahrscheinlich siehst du eine ZeichenWiederholung in einem Wort als eigenständiges Zeichen an. Ob das eine separate Zählung recht…fertigt, falls im anderen Wort nur einer davon auftauchen würde, was im 1.Bsp ja nicht so ist, wäre auch wichtig, denn das müsste ebenfalls berücksichtigt wdn. Aber viell haben das ja die vielen Lösungen, die inzwischen eigegangen sind, ja getan…
Ich hatte das mit UDF-haltigen Fmln ausprobiert und kam, je nach Fml, mal zu 4 und mal zu 5 Zeichen. Mit HÄUFIGKEIT (über den ZeichenCode) kam sogar ein falsches Ergebnis raus…?!
Morrn, Luc :-?


  

Betrifft: AW: Gleiche Zeichen von: Hajo_Zi
Geschrieben am: 10.11.2014 14:51:40

Hallo Alifa,

Deine Tabelle sieht also wie folgt aus.

Tabelle3

 AB
1QUELLTEXTGLUTHITZE
2QUELLTEXTDACHLATTE
3Wortwe
Excel-Inn.de
Hajo-Excel.de
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 18.20 einschl. 64 Bit


Option Explicit

Sub WortVergleich()
    Dim LoLetzte As Long
    Dim LoI As Long
    Dim LoJ As Long
    Dim LoK As Long
    LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
    For LoI = 1 To LoLetzte
        LoJ = 0
        If Len(Cells(LoI, 1)) = Len(Cells(LoI, 2)) Then
            For LoK = 1 To Len(Cells(LoI, 1))
                If InStr(Left(Cells(LoI, 1), LoK), Mid(Cells(LoI, 1), LoK, 1)) = 0 Then
                    If InStr(Cells(LoI, 2), Mid(Cells(LoI, 1), LoK, 1)) > 0 Then
                        LoJ = LoJ + 1
                    End If
                End If
            Next LoK
            If LoJ >= 5 Then
                MsgBox "Wörter in Zeile " & LoI & " ok!!!"
            Else
                MsgBox "Wörter in Zeile " & LoI & " nicht ok!!!"
            End If
        Else
            MsgBox "Wörter in Zeile " & LoI & " nicht gleiche Länge!!!"
        End If
    Next LoI
End Sub
GrußformelHomepage


  

Betrifft: AW: Gleiche Zeichen von: Daniel
Geschrieben am: 10.11.2014 14:54:26

Hi
hier mal der Code als Funktion.
Eingangsparameter sind die beiden Wörter, Rückgabewert ist die Anzahl gleicher Buchstaben.
Gross/Kleinschreibung wird ignoriert.

Function AnzahlGleicheBuchstaben(Wort1 As String, Wort2 As String) As Long
Dim X As Object
Dim b As String
Dim i As Long
Dim arr
Dim Zähler

Set X = CreateObject("Scripting.dictionary")
Wort1 = UCase(Wort1)
Wort2 = UCase(Wort2)

For i = 1 To Len(Wort1)
    ReDim arr(1 To 2) As Long
    b = Mid(Wort1, i, 1)
    arr(1) = Len(Wort1) - Len(Replace(Wort1, b, ""))
    arr(2) = 0
    X(b) = arr
Next

For i = 1 To Len(Wort2)
    b = Mid(Wort2, i, 1)
    If X.exists(b) Then
        arr = X(b)
    Else
        ReDim arr(1 To 2) As Long
        arr(1) = 0
    End If
    arr(2) = Len(Wort2) - Len(Replace(Wort2, b, ""))
    X(b) = arr
Next

arr = X.keys

For i = 0 To UBound(arr)
    Zähler = Zähler + WorksheetFunction.Min(X(arr(i)))
Next
AnzahlGleicheBuchstaben = Zähler

End Function
Gruß Daniel


  

Betrifft: AW: Das lässt sich noch kürzen von: Daniel
Geschrieben am: 11.11.2014 09:59:32

Die zweite Schleifen ist überflüssig

Function AnzahlGleicheBuchstaben(Wort1 As String, Wort2 As String) As Long
Dim X As Object
Dim b As String
Dim i As Long
Dim arr
Dim Zähler

Set X = CreateObject("Scripting.dictionary")
Wort1 = UCase(Wort1)
Wort2 = UCase(Wort2)
ReDim arr(1 To 2) As Long

For i = 1 To Len(Wort1)
    b = Mid(Wort1, i, 1)
    arr(1) = Len(Wort1) - Len(Replace(Wort1, b, ""))
    arr(2) = Len(Wort2) - Len(Replace(Wort2, b, ""))
    X(b) = arr
Next

arr = X.keys

For i = 0 To UBound(arr)
    Zähler = Zähler + WorksheetFunction.Min(X(arr(i)))
Next
AnzahlGleicheBuchstaben = Zähler

End Function



  

Betrifft: AW: Gleiche Zeichen von: ChrisL
Geschrieben am: 10.11.2014 15:03:51

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


  

Betrifft: und noch einer.. von: CitizenX
Geschrieben am: 10.11.2014 15:50:32

Hi,

hier noch eine Funktion mit Regex:

Option Explicit

Function CountMatch(Wort1, Wort2)
    Dim regex As Object: Set regex = CreateObject("vbscript.regexp")
    Dim objOut
    With regex
        .Global = True
        .ignorecase = True
        .Pattern = "[" & Wort1 & "]"
        Set objOut = .Execute(Wort2)
        CountMatch = objOut.Count
    End With
End Function
VG
Steffen


  

Betrifft: AW: und noch einer.. von: Alifa
Geschrieben am: 10.11.2014 18:15:38

Vielen Dank an die gute Gemeinde! Die Funktionen passen! Ich hoffe, dass die kürzeste auch die schnellste ist und werde die in mein Programm einsetzen.
Viele Grüße, Alifa


  

Betrifft: AW: und noch einer.. von: Alifa
Geschrieben am: 11.11.2014 00:16:09

Hi,
Die Funktion mit Regex gibt bei den Wörtern "QUALZUCHT" und "VOLLMACHT" 6 Übereinstimmungen. Es sind aber nur 5.
VG Alifa


  

Betrifft: Wörter einfach tauschen ... von: Matthias L
Geschrieben am: 11.11.2014 00:39:54

Hallo

Dann tausch mal Wort1 mit Wort2

 AB
1Qualzucht6
2Vollmacht5

Formeln der Tabelle
ZelleFormel
B1=CountMatch(A1;A2)
B2=CountMatch(A2;A1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Kommt ja ganz drauf an was Du mit was vergleichst

Gruß Matthias


  

Betrifft: AW: Wörter einfach tauschen ... von: Alifa
Geschrieben am: 11.11.2014 07:38:52

Hallo,
keines der Wörter hat Priorität. Es soll das gleiche Ergebnis geben, unabhängig davon, welches Wort an welcher Stelle steht. Die Funktionen von Chris und Daniel gewährleisten das. Man schreibt beide Wörter untereinander. Dann streicht man alle Buchstaben, die keinen "Partner" haben. Dann bleibt bei jedem Wort die gleiche Anzahl von Buchstaben.
VG Alifa


  

Betrifft: Hab ich schon richtig verstanden ... von: Matthias L
Geschrieben am: 11.11.2014 09:44:52

Hallo

Du hast dies geschrieben:
Die Funktion mit Regex gibt bei den Wörtern "QUALZUCHT" und "VOLLMACHT" 6 Übereinstimmungen. Es sind aber nur 5.

Zitat
Die Funktionen von Chris und Daniel gewährleisten das
Dann benutze sie doch!

Ich hatte Dir ja nur auf Deine Nachfrage geantwortet, warum ein unerwünschter Wert bei Dir rauskommt.
Also bitte nichts durcheinanderbringen!

Gruß Matthias


 

Beiträge aus den Excel-Beispielen zum Thema "Gleiche Zeichen"