VBA

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
  • VBA von Prter G vom 27.02.2005 18:29:36
    • AW: VBA - von Rudi am 27.02.2005 18:33:21
    • AW: VBA - von Ramses am 27.02.2005 19:11:46
Bild

Betrifft: VBA
von: Prter G
Geschrieben am: 27.02.2005 18:29:36
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

Bild

Betrifft: AW: VBA
von: Rudi
Geschrieben am: 27.02.2005 18:33:21
Wie willst du die einzelnen Argumente übergeben?
Rudi
Bild

Betrifft: AW: VBA
von: Ramses
Geschrieben am: 27.02.2005 19:11:46
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
 Bild

Beiträge aus den Excel-Beispielen zum Thema "problem mit - ActiveWorkbook.VBProject allg."