Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA alle gefundenen Zellen markieren

VBA alle gefundenen Zellen markieren
08.11.2016 08:33:06
Andreas
Hallo Excelfreunde,
Ich bin hier schon des Öfteren gut geholfen worden.
Ich benötige mal wieder professionelle Hilfe.
folgendes Problem:
In diesem Makro wird in Tabelle 1 ab Zeile 10 nach dem gefundenen Wert in Tabell1!A1 (frei definiert) gesucht. Alle gefundenen Werte werden dann fortlaufend nach Tabelle3 kopiert.
Das funktioniert auch bestens.
Jetzt möchte ich aber erreichen, das alle gefundenen Zellen die dem Kriterium in Tabelle1!A1 entsprechen auch in Tabelle1 zB. gelb Markiert werden also den ActiveCell.Interior.Colorindex 36 erhalten.
Kann mir jemand von Euch das Makro entsprechend anpassen?
Für Eure Hilfe wäre ich sehr dankbar
Sub finden2()
Dim ws1, ws2 As Worksheet
Dim last As Long
Dim rng As Range
Dim letzteZ1, letzteS1, letzteZ3 As Long
Dim Gesucht As String
Dim zell As Range
Dim x As Long
Set ws1 = Worksheets("Tabelle1")
Set ws2 = Worksheets("Tabelle3")
letzteZ1 = ws1.Cells(1048576, 3).End(xlUp).Row
letzteS1 = ws1.Cells(10, 256).End(xlToLeft).Column
letzteZ3 = ws2.Cells(1048576, 3).End(xlUp).Row
Set rng = ws1.Range(Cells(10, 3), Cells(letzteZ1, letzteS1))
Gesucht = "*" & ws1.Range("A1") & "*"
If Gesucht = "**" Then Exit Sub
For Each zell In rng
If zell.Value Like Gesucht Then
If ws2.Range("C" & letzteZ3) = "" Then letzteZ3 = 1 Else letzteZ3 = letzteZ3 + 1
ws1.Range(ws1.Cells(zell.Row, 2), ws1.Cells(zell.Row, 3)).Copy ws2.Range("D" & letzteZ3)
ws1.Range(ws1.Cells(1, 2), ws1.Cells(1, 5)).Copy ws2.Range("H" & letzteZ3)
ws1.Range(ws1.Cells(zell.Row, 2), ws1.Cells(zell.Row, letzteS1)).Copy ws2.Range("B" &  _
letzteZ3)
x = x + 1
End If
'ActiveCell.Interior.ColorIndex = 36
Next
If x = 0 Then MsgBox Gesucht & " nicht gefunden"
If x > 0 Then MsgBox Gesucht & " " & x & " mal gefunden"
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: VBA alle gefundenen Zellen markieren
08.11.2016 08:42:49
Peter
Hallo Andreas
zell.Interior.ColorIndex = 36
Gruß
Peter (hpo)
AW: VBA alle gefundenen Zellen markieren
08.11.2016 09:46:15
Andreas
Hallo Peter,
Danke erst einmal für Deine Rückmeldung.
zell.Interior.ColorIndex = 36
An welcher Stelle in meinem Code muß ich die Codezeile einfügen damit die gefundenen Zellen in der Tabelle1 auch gelb markiert werden?
Gruß Andreas
AW: VBA alle gefundenen Zellen markieren
08.11.2016 10:03:36
Peter
Hallo Andreas,
Ändere
'ActiveCell.Interior.ColorIndex = 36
auf
zell.Interior.ColorIndex = 36
Gruß
Peter (hpo)
AW: VBA alle gefundenen Zellen markieren
08.11.2016 10:07:14
Peter
Hallo Andreas,
Sub finden2()
Dim ws1, ws2 As Worksheet
Dim last As Long
Dim rng As Range
Dim letzteZ1, letzteS1, letzteZ3 As Long
Dim Gesucht As String
Dim zell As Range
Dim x As Long
Set ws1 = Worksheets("Tabelle1")
Set ws2 = Worksheets("Tabelle3")
letzteZ1 = ws1.Cells(1048576, 3).End(xlUp).Row
letzteS1 = ws1.Cells(10, 256).End(xlToLeft).Column
letzteZ3 = ws2.Cells(1048576, 3).End(xlUp).Row
Set rng = ws1.Range(Cells(10, 3), Cells(letzteZ1, letzteS1))
Gesucht = "*" & ws1.Range("A1") & "*"
If Gesucht = "**" Then Exit Sub
For Each zell In rng
If zell.Value Like Gesucht Then
If ws2.Range("C" & letzteZ3) = "" Then letzteZ3 = 1 Else letzteZ3 = letzteZ3 + 1
ws1.Range(ws1.Cells(zell.Row, 2), ws1.Cells(zell.Row, 3)).Copy ws2.Range("D" & letzteZ3)
ws1.Range(ws1.Cells(1, 2), ws1.Cells(1, 5)).Copy ws2.Range("H" & letzteZ3)
ws1.Range(ws1.Cells(zell.Row, 2), ws1.Cells(zell.Row, letzteS1)).Copy ws2.Range("B" &  _
letzteZ3)
x = x + 1
Zell.Interior.ColorIndex = 36
End If
Next
If x = 0 Then MsgBox Gesucht & " nicht gefunden"
If x > 0 Then MsgBox Gesucht & " " & x & " mal gefunden"
End Sub
so solltes funktionieren.
Gruß Peter (hpo)
Anzeige
AW: VBA alle gefundenen Zellen markieren
08.11.2016 11:00:59
Andreas
Hallo Peter,
vielen Dank für deine schnelle Hilfe
funktioniert bestens. So wollte ich es haben
liebe Grüße auch an alle anderen Helfer hier in diesem Forum

349 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige