Registriert seit: 07.03.2017
Version(en): 2002
29.03.2017, 19:43
(Dieser Beitrag wurde zuletzt bearbeitet: 29.03.2017, 19:46 von 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!
Registriert seit: 14.04.2014
Version(en): 2003, 2007
29.03.2017, 20:05
(Dieser Beitrag wurde zuletzt bearbeitet: 29.03.2017, 20:23 von 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
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28
• elgato2000
Registriert seit: 07.03.2017
Version(en): 2002
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"
Registriert seit: 07.03.2017
Version(en): 2002
Perfekt ! Jetzt passsst's !!!!!!!
Registriert seit: 07.03.2017
Version(en): 2002
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
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Felix,
nimm einfach den selben Code, nur die Prozedurbezeichnung und die Spalte ändern.
Gruß Atilla
Registriert seit: 29.09.2015
Version(en): 2030,5
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
Registriert seit: 07.03.2017
Version(en): 2002
@ Attila,
wie müsste das dann aussehen ?
Neues Makro ?
Registriert seit: 14.04.2014
Version(en): 2003, 2007
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
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28
• elgato2000
|