AW: Zelleninhalt suchen wenn gefunden dann...
16.11.2008 15:20:20
Tino
Hallo,
hier mal ein Beispiel, man könnte sich auch vorstellen für die Begriffe Auto oder Computer usw. jeweils eine Liste anzulegen, diese anhand der Liste abarbeiten.
Option Explicit
Sub Test()
Dim Bereich As Range, SuchZelle As Range
Dim SuchBergiff
Set Bereich = Range("F:F") 'Suchbereich
'Hier Handeingabe, oder aus einer Zelle übernehmen
SuchBergiff = "Auto" 'Dein Suchbegriff
Set SuchZelle = Bereich.Find(SuchBergiff, , xlValues, xlWhole)
If Not SuchZelle Is Nothing Then
Application.ScreenUpdating = False
Select Case SuchZelle
Case "Auto" '**************
Rows(SuchZelle.Row + 1).Insert Shift:=xlDown: SuchZelle.Offset(1, 0) = "Mazda"
Farbe SuchZelle.Offset(1, 0)
Rows(SuchZelle.Row + 1).Insert Shift:=xlUp: SuchZelle.Offset(1, 0) = "Ferrari"
Farbe SuchZelle.Offset(1, 0)
Case "Dach" '**************
Rows(SuchZelle.Row + 1).Insert Shift:=xlDown: SuchZelle.Offset(1, 0) = "flach"
Farbe SuchZelle.Offset(1, 0)
Case "Computer" '**************
Rows(SuchZelle.Row + 1).Insert Shift:=xlDown: SuchZelle.Offset(1, 0) = "Pentium"
Farbe SuchZelle.Offset(1, 0)
Rows(SuchZelle.Row + 1).Insert Shift:=xlDown: SuchZelle.Offset(1, 0) = "AMD"
Farbe SuchZelle.Offset(1, 0)
Rows(SuchZelle.Row + 1).Insert Shift:=xlDown: SuchZelle.Offset(1, 0) = "Selaron"
Farbe SuchZelle.Offset(1, 0)
'usw...
'...
'...
End Select
Application.ScreenUpdating = True
End If
End Sub
Sub Farbe(rZelle As Range)
'kommt auf die Finstellung an welche Farbe dies ist.
'Standart 3 = rot
rZelle.Font.ColorIndex = 3
End Sub
Gruß Tino