Macro um Zellen zu markieren

[elgato2000]

... eine kurze Nachrfrage:

Ich will das Makro in einer größeren Arbeitsmappe einbetten. Das Blatt nennt sich "CSV" und die zu durchsuchenden PLZ sind in Spalte "I" ab Zeile 2

Wie müsste ich den Code verändern ?

Viele Grüße!

[atilla]

Hallo Felix,

folgende Zeilen:

Code:

 lngZ = Cells(Rows.Count, 1).End(xlUp).Row
 ati = Range("A1:A" & lngZ)    'Bereich in dem gesucht werden soll

wie folgt ändern:

Code:

 lngZ = Cells(Rows.Count, 9).End(xlUp).Row  '9 steht für Spalte 9 = Spalte I ; in dieser Spalte wird die letzte belegte Zeile ermittelt
 ati = Range("I1:I" & lngZ)    'Bereich in dem gesucht werden soll

musste doch an verschiedenen Stellen noch angepasst werden, deshalb hier der gesamte angepasste Code:

Code:

Sub PLZ_suchen()
 Dim i As Long, lngZ As Long
 Dim rngZ As Range
 Dim varZeile
 Dim suchplZ
 Dim ati
 suchplZ = Array("18565", "25849", "25859", "25863", "25869", "25938", "25946", "25980", "25992", "25996", "25997", "25999", "26465", "26474", "26486", "26548", "26571", "26579", "26757", "27498")

lngZ = Cells(Rows.Count, 9).End(xlUp).Row
ati = Range("I1:I" & lngZ)    'Bereich in dem gesucht werden soll
For i = 1 To lngZ
 varZeile = 1 + UBound(Filter(suchplZ, ati(i, 1), True))
   If varZeile > 0 Then
     If rngZ Is Nothing Then
       Set rngZ = Cells(i, 9)
     Else
       Set rngZ = Union(rngZ, Cells(i, 9))
     End If
   End If
Next i

If Not rngZ Is Nothing Then
 Range("I2:I" & lngZ).Interior.Color = 10079487
  rngZ.Interior.Color = 13408767
  Set rngZ = Nothing
Else
  MsgBox "Keine PLz gefunden"
End If

End Sub

[elgato2000]

nanu, jetzt markiert er mir zwar die richtige Zeile, aber die Zelle in Spalte A

Und er verändert mir meine Headerrow, Also Zeile 1

Suchen ab I2 und markieren auch nur Zellen in "I"

[elgato2000]

Perfekt ! Jetzt passsst's !!!!!!!

[elgato2000]

Hallo Attila,


ich habe eine Nachfrage.

Kann man das Makro erweitern, so dass es in Spalte "F" nach vordefinierten Namen sucht und entsprechend markiert ? Also nicht nur nach vordefinierten Zahlen in Spalte "I" sondern eben auch nach Text in Spalte "F"

Vielen lieben Dank im Voraus !

Felix

[atilla]

Hallo Felix,

nimm einfach den selben Code, nur die Prozedurbezeichnung und die Spalte ändern.

[snb]

oder:

Code:

Sub M_snb()
    Names.Add "snb", Array(18565, 25849, 25859, 25863, 25869, 25938, 25946, 25980, 25992, 25996, 25997, 25999, 26465, 26474, 26486, 26548, 26571, 26579, 26757, 27498)
    
    Range(Join(Filter([transpose(if(iserror(match(A1:A200,snb,0)),"",address(row(1:200),1,4)))], "A"), ",")).Interior.ColorIndex = 15
End Sub

[elgato2000]

@ Attila,

wie müsste das dann aussehen ?

Neues Makro ?

[atilla]

Hallo Felix,

Code:

Sub PLZ_suchen_Spalte_F()
Dim i As Long, lngZ As Long
Dim rngZ As Range
Dim varZeile
Dim suchplZ
Dim ati
suchplZ = Array("18565", "25849", "25859", "25863", "25869", "25938", "25946", "25980", "25992", "25996", "25997", "25999", "26465", "26474", "26486", "26548", "26571", "26579", "26757", "27498")

lngZ = Cells(Rows.Count, 6).End(xlUp).Row
ati = Range("F1:F" & lngZ)    'Bereich in dem gesucht werden soll
For i = 1 To lngZ
varZeile = 1 + UBound(Filter(suchplZ, ati(i, 1), True))
  If varZeile > 0 Then
    If rngZ Is Nothing Then
      Set rngZ = Cells(i, 6)
    Else
      Set rngZ = Union(rngZ, Cells(i, 6))
    End If
  End If
Next i

If Not rngZ Is Nothing Then
Range("F2:F" & lngZ).Interior.Color = 10079487
 rngZ.Interior.Color = 13408767
 Set rngZ = Nothing
Else
 MsgBox "Keine PLz gefunden"
End If

End Sub