Teilweise Übereinstimmung von Wörtern
18.12.2018 13:09:06
Wörtern
da meine VBA-Fähigkeiten sich in Grenzen halten, wende ich mich mit meinem Problem an euch. Mein Makro tut schon einmal das, was es soll. Wird in Tabellenblatt2 in Spalte A ein Wort eingegeben und es findet eine Übereinstimmung mit Tabellenblatt1 Spalte F, wird das Wort dort farblich markiert. Änderungen werden ebenfalls berücksichtigt. Jetzt benötige ich noch einen Teil, der mir auch bei einer anteiligen Übereinstimmung das Wort farblich markiert z.B. Motor und Diesel Motor. Dann soll er die Zelle mit Diesel Motor ebenfalls markieren, da das Wort Motor enthalten ist. Ich glaube, es funktioniert mit der Methode "Contains". Leider bekomme ich es selber nicht hin.
Anbei mein Makro.
Vielen Dank im Voraus.
Public Sub Tabellen_Vergleichen()
Dim LoI As Long
Dim LoJ As Long
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
'Bereich festlegen: Tabelle2 Spalte A und Tabelle1 Spalte F
LoLetzte1 = 65536
With Worksheets("Tabelle2")
If .Range("A65536") = "" Then LoLetzte1 = .Range("A65536").End(xlUp).Row
End With
LoLetzte2 = 65536
With Worksheets("Tabelle1")
If .Range("F65536") = "" Then LoLetzte2 = .Range("F65536").End(xlUp).Row
End With
'Tabelle2 durchgehen und nach Werten > 0 suchen
For LoI = 1 To LoLetzte1
If Worksheets("Tabelle2").Cells(LoI, 1) > 0 Then
For LoJ = 1 To LoLetzte2
'Wenn Werte gefunden, gehe Tabelle1 Spalte F durch und vergleiche diese _
Werte. Bei gleichheit Orange markieren.
If Worksheets("Tabelle2").Cells(LoI, 1) = Worksheets("Tabelle1").Cells(LoJ, _
6) Then
Worksheets("Tabelle1").Cells(LoJ, 6).Style = "Schlecht"
End If
Next LoJ
End If
Next LoI
Dim VorhandeninTabelle2 As Boolean
VorhandeninTabelle2 = False
For LoJ = 1 To LoLetzte2
'Prüfung, ob Wert in Tabelle 1 Orange ist.
If Worksheets("Tabelle1").Cells(LoJ, 6).Style = "Schlecht" Then
For LoI = 1 To LoLetzte1
'Falls Wert Orange ist UND in Tabelle2 vorkommt, dann setze auf True.
If Worksheets("Tabelle1").Cells(LoJ, 6) = Worksheets("Tabelle2").Cells(LoI, 1) _
Then
VorhandeninTabelle2 = True
End If
Next LoI
'Falls Kombination = False, dann formatiere Zelle standardmäßig.
If VorhandeninTabelle2 = False Then
Worksheets("Tabelle1").Cells(LoJ, 6).Style = "Normal"
End If
End If
'Setze Prüfung auf False
VorhandeninTabelle2 = False
Next LoJ
End Sub