Vergleich von Wörtern mit Prozenten

[Nicki]

Hallo Allerseits,

Ich habe da ein kleines Problem bzw. ein kleine Aufgabe.
Ich möchte das mein Excel folgendes machen kann:

Es vergleicht die Wörter in einer Zelle mit den Wörtern in jeder anderen Zelle in der Spalte und falls es da eine Zelle gibt,
die mehr als z.B 50% übereinstimmung der Wörter hat, soll es mir das anzeigen mit einem Verweis zu der Zelle.

Beispiel:

                  Spalte A            Spalte B
    Zeile 1     B1, B3              Der Hund lief über den Rasen und freute sich
    Zeile 2     (leer)                Der Fuchs ist braun
    Zeile 3     B1, B3              Der Hund lief über den Rasen und fand einen Knochen

Hier sagt mir Excel, dass in Zelle B1 und B3 ähnliche Sätze vorhanden sind.

Hoffe das ist einigermaßen verständlich.
Es es wäre super wenn mir da jemand helfen kann!

[Fennek]

Hallo,

teste mal mit diesem Code:

Code:

Sub F_en()
Dim Anz As Integer
Range("A1:A3").Clear
lr = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To lr - 1
   Wd = Split(Cells(i, 2))
   For ii = i + 1 To lr
   Anz = 0
       For w = 0 To UBound(Wd)
           If InStr(1, Cells(ii, 2), Wd(w)) > 0 Then Anz = Anz + 1
       Next w
       If Anz > UBound(Wd) / 2 Then Cells(ii, 1) = Cells(ii, 1) & "Z" & i & ": " & Anz & "; "
   Next ii
Next i
End Sub

mfg

[Nicki]

Naja es ist auf jeden Fall etwas passiert :19:
Du musst wissen, dass ich auf dem Gebiet eher unbeholfen bin.
Ich kann das Makro Einfügen und laufen lassen aber verstehen kann ich es nicht wirklich.
Ich habe es mal über eine Typische Datei laufen lassen und heraus kam z.B. folgendes:


12Z1: 0; Z3: 4; Z4: 18; Z5: 15; Z11: 10; 


Ich weiß nur nicht was die Zahlen und Buchstaben bedeuten sollen. Verweise auf andere Zellen kann es ja wohl nicht sein, oder?
Die Spalte, die ich vergleichen lassen möchte ist Spalte B

[Nicki]

Ok mittlerweile verstehe ich (wahrscheinlich) was es macht.
Das ist schon mal gut nur leider noch nicht ganz das ich mir vorgestellt habe.

In Zelle 13 steht das folgende:

Z3: 4; Z4: 24; 


ich habe also in Zelle 13 einen verweis auf Zelle 3, mit der Angabe, dass es dort 4 Wörter gibt die Übereinstimmen.
Allerdings habe ich in Zelle 13 insgesamt 21 Wörter. Das sind also etwas mehr als 15% übereinstimmung.
Somit sollte es mich nicht auf Zelle 3 verweisen.

Es soll mich nur an eine andere Zelle verweisen, wenn es mehr als 50% Übereinstimmung gibt.


Ein weiteres Problem ist, dass die Reihenfolge der Wörter stimmen muss.
Wenn beispielsweise in einer Zelle steht "Hallo wie gehts?" und einer anderen steht "gehts Hallo wie?" wäre das wiederum 0%
übereinstimmung.

Sorry für die ganzen Sonderwünsche.
Ich weiß, dass es wahrscheinliche harte Nuss ist.
Danke schon mal für jegliche Hilfe!

[Ego]

Hallo N...,

hier einmal als UDF eingerichtet.
Du kannst die Funktion "Anteil" wie jede Excel-Standardfunktion in einer Formel nutzen. Siehe A3:A5
In Zelle A1 kannst du den Anteil bestimmen.


Die Spalten E:H waren nur zur Ermittlung von Prozentzahlen zum Testen.

Die Funktion hat noch einige Restriktionen:

1. Alle Sätze müssen mindestens zwei Worte haben
2. Trennzeichen zwischen den Worten ist ein Leerzeichen
3. Sonderzeichen werden von den Worten nicht getrennt.

Code:

Option Explicit

Public Function Anteil(strSatz As String, rngListe As Range, dblAnteil As Double) As String
Dim lngWort As Long
Dim lngZeile As Long
Dim lngAnzSatz As Long
Dim lngAnzAkt As Long
Dim dblAkt As Double
Dim varListe As Variant
Dim strWorte() As String
Dim strAkt As String
Dim dicSatz As Object
Dim dicAkt As Object

Set dicSatz = CreateObject("Scripting.Dictionary")
Set dicAkt = CreateObject("Scripting.Dictionary")
varListe = rngListe.Value

Anteil = ""
strSatz = LCase(strSatz)
strWorte = Split(strSatz, " ")
For lngWort = 0 To UBound(strWorte, 1)
    dicSatz(strWorte(lngWort)) = 1
Next lngWort
lngAnzSatz = dicSatz.Count

For lngZeile = 1 To UBound(varListe, 1)
    strAkt = LCase(varListe(lngZeile, 2))
    If strAkt <> strSatz And strAkt <> "" Then
        lngAnzAkt = 0
        strWorte = Split(strAkt, " ")
        For lngWort = 0 To UBound(strWorte, 1)
            If Not dicAkt.exists(strWorte(lngWort)) Then
                dicAkt(strWorte(lngWort)) = 1
                If dicSatz.exists(strWorte(lngWort)) Then
                    lngAnzAkt = lngAnzAkt + 1
                End If
            End If
        Next lngWort
        dicAkt.RemoveAll
        dblAkt = lngAnzAkt / lngAnzSatz
        If dblAkt >= dblAnteil Then
            Anteil = Anteil & ", " & varListe(lngZeile, 1)
        End If
    End If
Next lngZeile

If Len(Anteil) > 2 Then
    Anteil = Right(Anteil, Len(Anteil) - 2)
End If

Set dicSatz = Nothing
Set dicAkt = Nothing
End Function

[Ego]

Hallo N...,

sorry habe gerade erste gelesen

Ein weiteres Problem ist, dass die Reihenfolge der Wörter stimmen muss.

Das kann alles sehr viel einfacher machen, wenn ich nur bis zum ersten abweichenden Wort suchen muss.

[Nicki]

Hallo N...,

sorry habe gerade erste gelesen

Das kann alles sehr viel einfacher machen, wenn ich nur bis zum ersten abweichenden Wort suchen muss.

Ja war mein Fehler. Das hätte ich wohl früher erwähnen sollen

[Nicki]

Hallo N...,

sorry habe gerade erste gelesen

Das kann alles sehr viel einfacher machen, wenn ich nur bis zum ersten abweichenden Wort suchen muss.

Allerdings finde ich super wie es funktioniert. Es scheint so ziemlich das zu machen was ich brauche.
Ich werde jetzt mal ein bisschen damit arbeiten und schauen, ob das anhält.
Soweit auf jeden Fall mal vielen Dank!

[Ego]

Hallo N...,

hier der Vergleich bis zum ersten abweichenden Wort.

Code:

Option Explicit

Public Function Anteil(strSatz As String, rngListe As Range, dblAnteil As Double) As String
Dim lngWort As Long
Dim lngZeile As Long
Dim lngAnzSatz As Long
Dim lngAnzAkt As Long
Dim lngAnzGleich As Long
Dim dblAkt As Double
Dim varListe As Variant
Dim strWorteSatz() As String
Dim strWorteAkt() As String
Dim strAkt As String
Dim blnWeiter As Boolean

varListe = rngListe.Value

Anteil = ""
strWorteSatz = Split(strSatz, " ")
lngAnzSatz = UBound(strWorteSatz) + 1

For lngZeile = 1 To UBound(varListe, 1)
    strAkt = varListe(lngZeile, 2)
    If strAkt <> strSatz And strAkt <> "" Then
        strWorteAkt = Split(strAkt, " ")
        lngAnzAkt = UBound(strWorteAkt) + 1
        If lngAnzAkt > lngAnzSatz Then
            lngAnzAkt = lngAnzSatz
        End If
        lngAnzGleich = 0
        lngWort = 0
        blnWeiter = True
        Do While lngWort < lngAnzAkt And blnWeiter
            If strWorteSatz(lngWort) <> strWorteAkt(lngWort) Then
                blnWeiter = False
                lngAnzGleich = lngWort
            End If
            lngWort = lngWort + 1
        Loop
        dblAkt = lngAnzGleich / lngAnzSatz
        If dblAkt >= dblAnteil Then
            Anteil = Anteil & ", " & varListe(lngZeile, 1)
        End If
    End If
Next lngZeile

If Len(Anteil) > 2 Then
    Anteil = Right(Anteil, Len(Anteil) - 2)
End If

End Function

[Nicki]

Hallo N...,

hier der Vergleich bis zum ersten abweichenden Wort.

Code:

Option Explicit

Public Function Anteil(strSatz As String, rngListe As Range, dblAnteil As Double) As String
Dim lngWort As Long
Dim lngZeile As Long
Dim lngAnzSatz As Long
Dim lngAnzAkt As Long
Dim lngAnzGleich As Long
Dim dblAkt As Double
Dim varListe As Variant
Dim strWorteSatz() As String
Dim strWorteAkt() As String
Dim strAkt As String
Dim blnWeiter As Boolean

varListe = rngListe.Value

Anteil = ""
strWorteSatz = Split(strSatz, " ")
lngAnzSatz = UBound(strWorteSatz) + 1

For lngZeile = 1 To UBound(varListe, 1)
    strAkt = varListe(lngZeile, 2)
    If strAkt <> strSatz And strAkt <> "" Then
        strWorteAkt = Split(strAkt, " ")
        lngAnzAkt = UBound(strWorteAkt) + 1
        If lngAnzAkt > lngAnzSatz Then
            lngAnzAkt = lngAnzSatz
        End If
        lngAnzGleich = 0
        lngWort = 0
        blnWeiter = True
        Do While lngWort < lngAnzAkt And blnWeiter
            If strWorteSatz(lngWort) <> strWorteAkt(lngWort) Then
                blnWeiter = False
                lngAnzGleich = lngWort
            End If
            lngWort = lngWort + 1
        Loop
        dblAkt = lngAnzGleich / lngAnzSatz
        If dblAkt >= dblAnteil Then
            Anteil = Anteil & ", " & varListe(lngZeile, 1)
        End If
    End If
Next lngZeile

If Len(Anteil) > 2 Then
    Anteil = Right(Anteil, Len(Anteil) - 2)
End If

End Function

Ja das scheint noch besser zu funktionieren. Gehe ich recht in der Annahme, dass es, wenn ich z.B 10% eingebe mir alle Zellen anzeigt, bei denen 10% der Wörter
in dieser speziellen Reihenfolge übereinstimmen?