Kategorisierung von Keywords durch Macro

Hi,
ich hoffe jemand kann mir helfen bei diesem Vorhaben.
Was vorhanden ist:
Ich habe im Excel Tabellenblatt "Kategorien" eine Auflistung von 13 Kategorien von A bis M.
Bsp: A1 ist die Kategorie "Schuhe", A2 wäre dann Lederschuhe, A3 Sportschuhe etc.
B1 "Taschen" etc.
In einem anderen Tabellenblatt "Keywords" habe ich eine Auflistung von verschiedenen Keywords in einer Table.
A1 wäre Keywords, A2 bis unendlich wären dann verschiedene Keywords. B1, C1 und D1 sind verschiedene Werte die sich auf ein einzelnes Keyword beziehen, wie Preis, Konkurrenz etc.
Das Vorhaben:
Von E1 beginnend würde ich gerne die einzelnen Kategorien aufzählen die ich in "Kategorien" habe und ein Macro soll testen, ob ein string der zu einem der Kategorien gehört in dem einzelnen Keyword auftaucht. Dabei spielt es keine Rolle, ob der string ein einzelnes Wort ist oder nur Bestandteil eines ganzen Wortes. Wenn der string im Keyword auftaucht, so soll ein "Ja" rauskommen, ansonsten "nein".
Bsp:
Tabellenblatt "Keywords":
A36 ist "neue Lederschuhe mit Ledertasche", Macro schaut nach, ob dieses Keyword in einem der Kategorien vorkommt, in diesem Fall in der Kategorie "Schuhe" und schreibt dann in E36 ja, aber es schreibt auch ja in der Kategorie "Taschen", da Ledertasche auch zu einer Kategorie gehört.
Ich hoffe ihr versteht was ich meine.
Vielen Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Juri,
hier ein Beispiel-Makro, wie man es grundsätzlich lösen könnte. Dieses muss du dann ggf. noch an deine Aufgabenstellung anpassen.
Gruß
Franz

'Makro in einem allgemeinne Modul
Sub KategorienFinden()
Dim wksKey As Worksheet
Dim wksKat As Worksheet
Dim rngKat As Range, ZelleKat As Range
Dim ZeileKey As Long, SpalteKey As Long, SpalteKat As Long, StatusCalc As Long
Dim strWertA As String, strKat As String
Set wksKat = ActiveWorkbook.Worksheets("Kategorien")
Set wksKey = ActiveWorkbook.Worksheets("Keywords")
'Makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With wksKey
'Zeilen im Blatt "Keywords" abarbeiten
For ZeileKey = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
strWertA = .Cells(ZeileKey, 1).Text
If strWertA  "" Then
'Spalten ab Spalte E abarbeiten
For SpalteKey = 5 To .Cells(1, .Columns.Count).End(xlToLeft).Column
strKat = .Cells(1, SpalteKey).Text
If strKat  "" Then
With wksKat
'Kategorie-Titel in Zeile 1 des Blatts Kategorien suchen
Set ZelleKat = .Rows(1).Find(what:=strKat, LookIn:=xlValues, lookat:=xlWhole)
If ZelleKat Is Nothing Then
If MsgBox("Kategorie """ & strKat & """ aus Zeile 1 in Blatt """ _
& wksKey.Name & """ ist in Blatt """ & wksKat.Name & """ nicht vorhanden.", _
vbOKCancel, "Kategorien suchen") = vbCancel Then GoTo Beenden
Else
SpalteKat = ZelleKat.Column
'Bereich mit den Kategoriewerten setzen
Set rngKat = .Range(.Cells(2, SpalteKat), .Cells(.Rows.Count, SpalteKat).End( _
xlUp))
'Inhalt in Zielzelle löschen
wksKey.Cells(ZeileKey, SpalteKey).ClearContents
'Zellen mit Kategorie-Werten abarbeiten
For Each ZelleKat In rngKat
If ZelleKat.Value  "" Then
If InStr(1, strWertA, ZelleKat.Value) > 0 Then
'                  If InStr(1, LCase(strWertA), LCase(ZelleKat.Value)) > 0 Then
wksKey.Cells(ZeileKey, SpalteKey).Value = "Ja"
Exit For
End If
End If
Next ZelleKat
End If
End With 'wksKat
End If
Next SpalteKey
End If
Next ZeileKey
End With 'wksKey
Beenden:
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
Set wksKey = Nothing: Set wksKat = Nothing: Set rngKat = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

Kategorisierung von Keywords durch Macro

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread