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!
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
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
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!
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
Hallo N...,
sorry habe gerade erste gelesen
Zitat: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.
(10.03.2018, 22:26)Ego schrieb: [ -> ]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
(10.03.2018, 22:26)Ego schrieb: [ -> ]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!
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
(10.03.2018, 23:07)Ego schrieb: [ -> ]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?