Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
576to580
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
576to580
576to580
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA

VBA
27.02.2005 18:29:36
Prter
Hallo
ich suche nach einer Möglichkeit per VBA, ein Tabellenblatt nach bestimmten Argumenten zu durchsuchen,
wie z. B. "Argument 1", Argument 2" usw. Da es sich hier um ca. 20 Argumente handelt, scheidet die
bedingte Formatierung aus. Sollte das gesuchte Argument zutreffen, soll die gefundene Zelle plus die zwei
darunter befindlichen Zellen schwarz gefärbt werden. Die Suche sollte von B8-B200:H8-H200 durchgeführt
werden. Wichtig ist noch, das nicht nur ein zutreffendes Argument gefunden wird, sondern das es sich
durchaus um viele handeln kann. Es müssen also u. U. mehrere Zellen gefärbt werden.
Wer weiss wie ich dabei vorgehen müsste ? Für Tipps bedanke ich mir bereits im voraus

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA
Rudi
Wie willst du die einzelnen Argumente übergeben?
Rudi
AW: VBA
Ramses
Hallo
hier mal eine Variante die das erfüllt was du haben willst
Option Explicit

Sub MultiFormatArray()
'by Ramses
'Sucht im definierten Bereich nach einem Begriff aus einem Array
'und färbt diese und die beiden nachfolgenden ein
Dim myC As Range, rng As Range, srchArea As Range
Dim i As Integer, myColor As Integer
Dim sAddress As String
'Suchbegriffe in Array auf 20 anpassen
Dim sFind() As Variant
'Suchebegriffe definieren
sFind = Array("1", "2", "3", "4", "5", "Muster", "Muster2", "Muster3", "Muster4", "Muster5")
'Suchbereich definieren
Set srchArea = Range("B8:H800")
'Farbe definieren
'1 = schwarz
'2 = weiss
'3 = rot
'4 = grün
'5 = blau
'6 = gelb
myColor = 1
For i = 0 To UBound(sFind)
Set rng = srchArea.Find(What:=sFind(i), _
LookAt:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
'Für die Automation kann die "If"-Anweisung auskommentiert werden
Range(rng, rng.Offset(2, 0)).Interior.ColorIndex = myColor
Debug.Print "Suchbegriff: " & sFind(i) & ",gefunden in " & rng.Address
Set rng = srchArea.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
NextStart:
Next i
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Gruss Rainer
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige