Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1496to1500
1496to1500
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ähnliche Begriffe finden

Forumthread: Ähnliche Begriffe finden

Ähnliche Begriffe finden
06.06.2016 15:38:18
hammsi
Hello again!
Ist es möglich, Zellen innerhalb eines Arbeitsblattes automatisch zu markieren, sobald darin enthaltene Begriffe in anderen Zellen ebenfalls vorkommen? Ich darf euch ein Musterdokument beisteuern, um die Geschichte etwas plastischer zu gestalten.
https://www.herber.de/bbs/user/106027.xlsx
Worttrennende Beistriche habe ich bewusst mal mit und mal ohne Leerzeichen versehen. Nach Adamriese sollten am Ende 5 Zellen markiert sein. Wenn es überdies dann noch ne Formel gibt, die diese Begriffe sogar extrahiert, wäre es der Super-Ober-Megahit.
Jetzt schon 1000 Dank und lg,
Thomas

Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
106027_MehrfachmarkierungDic
06.06.2016 17:31:04
Michael
Hi Thomas,
das geht am einfachsten mit einem "Dictionary".
Näheres dazu kannst Du recherchieren mit: Excel vba Scripting.dictionary
Der Code: 
Option Explicit
Sub mehrfacheMarkieren()
Dim it, oDic As Object, beg$, aBeg, key$, i&
Dim r As Range, vorh As Boolean
Set oDic = CreateObject("scripting.dictionary")
'Range("A1,c3").Select Diese Zeile bitte in der Datei löschen****
For Each r In UsedRange
beg = r.Text
If beg  "" Then
aBeg = Split(Trim(LTrim(beg)), ",")
If UBound(aBeg) >= 0 Then
For i = 0 To UBound(aBeg)
key = Trim(LTrim(aBeg(i)))
If key  "" Then
If oDic.exists(key) Then
oDic(key) = oDic(key) & "," & r.Address(0, 0)
Else
oDic(key) = r.Address(0, 0)
End If
End If
Next
Else
MsgBox "warum: " & beg
End If
End If
Next
' So kannst Du das Dic ausgeben lassen *****
'Range("F1").Resize(oDic.Count) = WorksheetFunction.Transpose(oDic.keys)
'Range("G1").Resize(oDic.Count) = WorksheetFunction.Transpose(oDic.items)
For Each it In oDic.items
If Len(it) > 2 Then
If vorh Then
beg = beg & "," & it
Else
beg = it
vorh = True
End If
End If
Next
Range(beg).Select
End Sub

Die Datei: https://www.herber.de/bbs/user/106032.xlsm
Schöne Grüße,
Michael

Anzeige
AW: 106027_MehrfachmarkierungDic
07.06.2016 10:32:02
hammsi
Magic, funktioniert! Hat mir sehr geholfen - DANKE

gerne, danke für die Rückmeldung owT
07.06.2016 16:15:41
Michael

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige