Office: (Office 2013) Zellinhalt vergleichen ohne auf die Reihenfolge der Zeichen zu achten

Hallo WS-53,

interessante Lösung, aber Helmuts Lösung dürfte eine bessere Trefferqualität haben. Denn 134 ist nicht 143. Und "Reh" ist nicht "her". In meiner Erweiterung wollte ich noch mit Stellenfaktoren rechnen, aber das hat sich nun erledigt, da Helmut eine noch bessere Lösung gefunden hat.

Was Du mit

PHP:

         =WECHSELN(GROSS(LINKS(A8&WIEDERHOLEN(ZEICHEN(32);20);20));"/€´²³°§~}|{_^][><;:.-,+*&%$!";"")


 

Hallo,

bei so langen Formeln bin ich zwar beeindruckt, mache mir aber selten die Mühe sie nachzuvollziehen.

Aufbauend auf dem ersten post des Fragestellers habe ich mir einige Codes generiert und dann mit VBA ausgewertet. Hier der Code:

PHP:

         Sub Daten_generieren2()
Dim WS As Worksheet: Set WS = ActiveSheet
Anz = 25
With Range("A1:A" & Anz)
.Formula = "=Row() & ""/"" & Row() + 100 & ""/MA/XXII"""
.Offset(, 2).Formula = "=Row() & ""/MA/XXII/"" & Row() + 100"
.Value = .Value
.Offset(, 2).Value = .Offset(, 2).Value
.Offset(, 2).Copy Range("A" & Anz + 1)
.Offset(, 2).Clear
End With
With Range("B1:B" & 2 * Anz)
.Formula = "=rand()"
.Value = .Value
End With
With WS.Sort
With .SortFields
.Clear
.Add Key:=WS.Range("B1"), Order:=xlAscending
End With
.Header = xlNo
.SetRange rng:=WS.Cells(1).CurrentRegion
.Apply
End With
WS.UsedRange.Columns("B").Clear
End Sub
'
'#### Auswertung ###
'
Sub vergleichen()
Dim WS As Worksheet: Set WS = ActiveSheet
Dim Res()
fen = Cells(1).CurrentRegion.Resize(, 2)
ReDim Res(1 To UBound(fen), 1 To 2)
For i = 1 To UBound(fen)
fen(i, 2) = SAsc(fen(i, 1))
Next i
Cells(1, "C").Resize(UBound(fen), 2) = fen
With WS.Sort
With .SortFields
.Clear
.Add Key:=WS.Range("D1"), Order:=xlAscending
End With
.Header = xlNo
.SetRange rng:=WS.Cells(1, 3).CurrentRegion
.Apply
End With
fen = Range("C1").CurrentRegion
Range("C1").CurrentRegion.Clear
For i = 1 To UBound(fen) - 1
j = i + 1
Do While fen(i, 2) = fen(j, 2)
G = Gleich2(fen(i, 1), fen(j, 1))
If G = 4 Then
r = r + 1
Res(r, 1) = fen(i, 1)
Res(r, 2) = fen(j, 1)
End If
j = j + 1
If j > UBound(fen) Then Exit Do
Loop
Next i
Range("F1").Resize(UBound(Res), 2) = Res
End Sub

Function SAsc(ByVal Tx As String) As Integer
Dim by() As Byte
by = Tx
SAsc = WorksheetFunction.Sum(by)
End Function
Sub Test1()
Debug.Print SAsc("ABC")
End Sub
Function Gleich2(ByVal Tx1 As String, ByVal Tx2 As String) As Integer
T1 = Split(Tx1, "/")
T2 = Split(Tx2, "/")
G = 0
If UBound(T1) = UBound(T2) Then
For i1 = 0 To UBound(T1)
For i2 = 0 To UBound(T2)
If T1(i1) = T2(i2) Then G = G + 1
Next i2
Next i1
End If
'Debug.Print G, Tx1, Tx2
Gleich2 = G
End Function


 

Hallo Ingo,

Die Formel in Spalte "B" sollte nur noch in GROSS umwandeln. Aber da ist noch ein falscher Stand übrig geblieben.

Ja, die Lösung von Helmut (Oge) ist schon sehr beeindruckend. Allerdings setzt diese voraus, dass der "/" immer das trennende Element eines gruppierten Begriffs ist.

In den bisher von Tobey genannten Beispielen ist dies zwar so, aber ob dies immer so ist, ist bisher noch nicht klar.

Ich habe aber nun die Beispiele von Helmut in meine Lösung eingearbeitet und musste dann feststellen, dass bei den etwas längeren Begriffen, die Zahlenwerte durch KGRÖSSTE() komplett ignoriert wurden. Somit wurden zu viele als "identisch" erkannt.

Aus diesem Grund habe ich nun in Spalte "D" die 10 größten mit den 10 kleinsten verkettet.

Natürlich wird nun immer noch 143 / 134 und Reh / her als identisch erkannt. Aber die Suche mit Fuzzy-Logiken/phonetische Suche wird zumindest teilweise ähnlich verfahren, da sonst Namen bzw. Begriffe, die mit Buchstabendrehern erfasst wurden, der suchende nicht mehr finden würde.

Für das auffüllen der Leerstellen verwende ich nun das ">", da der Code zwischen den Zahlen und Buchstaben liegt.

Die Idee ist dabei, lieber etwas mehr eigen, aber möglichst nie zu wenig zeigen.

Da werden dir dann bspw. bei der Suche nach Taxi auch die gezeigt, die in der Datenbank mit Taksi gespeichert wurden.

 

Hallo WS-53,

da sieht man mal wieder, was so alles möglich ist. Und mit jedem Versuch wird man besser. Schön! Aber jetzt würde mich mehr interessieren, was der Threadstarter denn nun von all diesen Lösungen braucht. Genial sind alle Lösungen, je nachdem was man für einen Anspruch hat.

kollegiale Grüße
Ingo

Nachtrag:
Als Tipp: Arbeite bei langen Formeln mal mehr mit Zeilenumbruch (ALT + ENTER), damit gleiche Formelteile unter gleichen Formelteilen stehen. Dann sind die Formeln leichter lesbar und änderbar!

 

Hallo,

um die Buchstaben einer Zelle zu sortieren, reicht diese Funktion:

PHP:

         Function Buchst_sort(ByVal rng As Range) As String
With CreateObject("system.collections.arraylist")
Tx = rng.Value
For b = 1 To Len(Tx)
'If Not .contains(Mid(Tx, b, 1)) Then .Add Mid(Tx, b, 1) 'löscht Duplikate
.Add Mid(Tx, b, 1)
Next b
.Sort
Buchst_sort = Join(.toarray, "")
End With
End Function


 

Hallo Ingo,

Klingt vielleicht etwas blöd, aber ich wusste gar nicht dass dies geht. Dabei habe ich selbst schon häufig geärgert, wenn Formeln, egal ob eigene oder fremde, so schlecht lesbar waren.

Und natürlich ist es richtig, dass der TS feststellen muss, ob es eine für seine Fälle am besten passende Lösung gibt.

Leider hat er sich nur sehr knapp formuliert, anstatt eine Mappe hochzuladen, die alle möglichen Konstellationen gezeigt hätte.

Aber auch die VBA-Funktion von Fennek zum sortieren eines Feldinhalts ist genial einfach und sofort nachvollziehbar. Aber bei meinem VBA-Level, wäre ich nicht auf diese einfache Lösung gekommen. Die werde ich mir aber unbedingt merken müssen.

 

Hallo,

das Sortieren von Buchstaben einer Zelle geht auch mit "traditionellem" VBA:

PHP:

         Function Buch_sort(rng As Range, Optional Dr As Boolean) As String
Dim By() As Byte
Dim L As Integer: L = Len(rng.Value)
By = rng.Value
ReDim Bout(L)
For i = 1 To L
If Dr Then
Buch_sort = Chr(WorksheetFunction.Large(By, i)) & Buch_sort
Else
Buch_sort = Buch_sort & Chr(WorksheetFunction.Large(By, i))
End If
Next i
End Function