Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1776to1780
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Patterns suchen (ab 3 gleiche Zeichen)

Patterns suchen (ab 3 gleiche Zeichen)
28.08.2020 13:06:36
Simone
Hallo zusammen,
ich habe folgendes Problem:
Ich habe den Bereich A1 bis A10. In jeder dieser Zellen stehen mind. 30 Zeichen ohne Leerzeichen.
Bspw. in A1:
BHGTZUKLMKIOKLMJUTFDRTKLMAHGTZ
Aus diesem String in A1 würde ich gerne alle Patterns, also Buchstabenmuster ab 3 Zeichen extrahieren, die mind. zweimal vorkommen. In diesem Fall würde ich gerne in A15 "KLM" und B15 "3" ausweisen. Also das Wortmuster "KLM" wurde dreimal gefunden. Darunter A16 "GTZ" und in B16 "2". Also das Wortmuster "GTZ" wurde zweimal gefunden.
Ich kenne die Wortmuster (GTZ etc.) nicht, daher muss VBA irgendwie den String prüfen und schauen ob Kombinationen mehr als einmal vorkommen.
Ich hoffe ihr versteht was ich meine :-)
Liebe Grüße und Danke
Simone

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Patterns suchen (ab 3 gleiche Zeichen)
28.08.2020 13:36:56
Daniel
Hi
mal so auf die schnelle.
Sub Ausführen()
Call MusterFinden(Range("A1").Value, Range("A15"))
End Sub
Sub MusterFinden(Text As String, AusgabeAb As Range)
Dim L As Long
Dim i As Long
Dim Anzahl As Long
Dim Gefunden As String
Dim P As String
Gefunden = "|"
For L = 3 To Len(Text) / 2
For i = 1 To Len(Text) - L
P = Mid(Text, i, L)
If InStr(Gefunden, "|" & P & "|") = 0 Then
Anzahl = (Len(Text) - Len(Replace(Text, P, ""))) / L
If Anzahl > 1 Then
Gefunden = Gefunden & P & "|"
AusgabeAb.Value = P
AusgabeAb.Offset(0, 1).Value = Anzahl
Set AusgabeAb = AusgabeAb.Offset(1, 0)
End If
End If
Next
Next
End Sub
Gruß Daniel
Anzeige
AW: Patterns suchen (ab 3 gleiche Zeichen)
28.08.2020 13:48:02
Simone
Hallo Daniel,
wow ... perfekt!!!! :-)
Wie kann ich es noch anpassen, dass A1:A10 komplett durchsucht wird und das gesamte Ergebnis in
A15 ausgewiesen wird? Ich habe es mit "MusterFinden(Range("A1:A10").Value" versucht ... aber kein Erfolg gehabt.
Vielen Dank!
Grüße
Simone
AW: Patterns suchen (ab 3 gleiche Zeichen)
28.08.2020 14:00:22
Daniel
Hi
die "Funktion" MusterFinden ist jetzt auf Einzelwerte ausgelegt.
du kannst jetzt die Schleife über mehrere Zellen in die aufrufende Sub einbauen oder in die "Funktion" selbst.
dann wäre noch zu klären, ob du jetzt jede Zelle einzeln betrachtet haben willst, oder ob der ganze Text als ein Block betrachtet werden soll und wie das Ergebnis aussehen soll.
Gruß Daniel
Anzeige
AW: Patterns suchen (ab 3 gleiche Zeichen)
28.08.2020 15:20:02
Simone
Hallo Daniel,
es geht um den ganzen Text. Ich habe jetzt einfach alle Zeilen in einen String gepackt
und lasse diesen durchsuchen. Funktioniert super!
Danke auch an Fennek. Die Lösung funktioniert auch klasse.
Danke und Grüße
Simone
AW: so ähnlich
28.08.2020 13:40:59
Fennek
Hallo,
teste mal mit diesem Code, wenn dann noch doppelte entfernt werden, könnte es passen:

Sub Main
for rr = 1 to cells(rows.count, 1).end(xlup).row
Tx = cells(rr, 1)
ll = len(Tx)
for b = 1 to len(Tx)-3
f3 = mid(Tx, b, 3)
if ll - len(replace(Tx, f3, ""))  > 3 then
lr = cells(rows.count,2).end(xlup).row +1
cells(lr,2) = rr
cells(lr,3) = mid(Tx,b, 3)
end if
next b
next rr
End Sub
mfg
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige