Hallo
ich möchte ein Macro erstellen, welches Postleitzahlen in Spalte A mit einer vordefinierten Liste vergleicht, und wenn eine PLZ vorkommt, die entsprechende Zelle markiert.
Beispiel anbei.
Ich weiß, dass man das auch mit einer Formel machen kann, aber ich benötige ein Macro. Die vordefinierten PLZ sollten im Macro enthalten sein, nicht wie im Beispiel in Spalte C
Vielen Dank !!!
Hallo Felix,
wie viele vordefinierte PLZ sind es denn?
Und warum im Makro und nicht in irgendeiner Hilfsspalte? Da kannst Du dann jederzeit unproblematisch Änderungen vornehmen.
(29.03.2017, 11:55)atilla schrieb: [ -> ]Hallo Felix,
wie viele vordefinierte PLZ sind es denn?
Und warum im Makro und nicht in irgendeiner Hilfsspalte? Da kannst Du dann jederzeit unproblematisch Änderungen vornehmen.
Hallo Atilla
die vordefinierten PLZ sind in Spalte C der Beispieldatei
Hilfsspalte wäre blöd, weil das Sheet in einem späteren Schritt komplett gesäubert wird. Und ein extra Sheet nur dafür wäre auch nicht so toll ....
Hallo Felix,
können denn auch doppelte in Spalte A vorkommen?
Man kann die Suche nämlich auf zweierlei Weise durchführen. Mann kann jeden Wert aus A in B suchen oder umgekehrt.
Da in B weniger steht, wäre es sinnvolle B in A zu suchen. Um doppelte zu finden, müsste man dann anders vorgehen.
Hier eine Variante ohne Doppelte:
Code:
Sub ausblenden()
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, 1).End(xlUp).Row
ati = Range("A1:A" & lngZ) 'Bereich in dem gesucht werden soll
For i = 0 To UBound(suchplZ)
varZeile = Application.Match(CLng(suchplZ(i)), ati, 0)
If IsNumeric(varZeile) Then
If rngZ Is Nothing Then
Set rngZ = Cells(varZeile, 1)
Else
Set rngZ = Union(rngZ, Cells(varZeile, 1))
End If
End If
Next i
If Not rngZ Is Nothing Then
Range("A1:A" & lngZ).Interior.Color = 10079487
rngZ.Interior.Color = 13408767 ' .Hidden = True
Else
MsgBox suchplZ & " in keiner Spalte gefunden!"
End If
End Sub
... irgendwas stimmt nicht. Beim ersten Durchlauf funzt es, wenn ich dann aber z.B. "25980" in A17 eintrage und dann das Macro nochmal laufen lassen, wird A17 nicht markiert.
Hallo Felix,
das hat mit den Daten in Spalte A zu tun. Die sind mal Text mal Zahl.
Ich das jetzt mal ganz primitive gelöst:
Code:
Sub suche()
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, 1).End(xlUp).Row
ati = Range("A1:A" & lngZ) 'Bereich in dem gesucht werden soll
For i = 0 To UBound(suchplZ)
If IsNumeric(Application.Match(CStr(suchplZ(i)), ati, 0)) Then varZeile = Application.Match(CStr(suchplZ(i)), ati, 0)
If IsNumeric(Application.Match(CLng(suchplZ(i)), ati, 0)) Then varZeile = Application.Match(CLng(suchplZ(i)), ati, 0)
If varZeile > 0 Then
If rngZ Is Nothing Then
Set rngZ = Cells(varZeile, 1)
Else
Set rngZ = Union(rngZ, Cells(varZeile, 1))
End If
End If
Next i
If Not rngZ Is Nothing Then
Range("A1:A" & lngZ).Interior.Color = 10079487
rngZ.Interior.Color = 13408767 ' .Hidden = True
Else
MsgBox suchplZ & " in keiner Spalte gefunden!"
End If
End Sub
Du hast aber nichts dazu gesagt, ob doppelte vorkommen können. Deswegen gehe ich mal davon aus, dass das nicht der Fall ist.
primaaaaaa ::)
und ja ... doppelte können vorkommen. Wenn z.b. zwei unterschiedliche Meschen von Sylt bestellen :)
Aber Felix,
ich schrieb doch, dann muss der Code ganz anders aufgebaut werden.
Und was ist, wenn zwei Leute aus Münschen bestellen, sind das auch Doppelte? :19:
(auf die letzte Frage brauchst Du nicht antworten)
Aber eine Lösung für doppelte kann ich vielleicht heute Abend liefern.
Hallo Felix,
musste doch nicht ganz anders aufgebaut werden.
Ging sogar einfacher:
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, 1).End(xlUp).Row
ati = Range("A1:A" & 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, 1)
Else
Set rngZ = Union(rngZ, Cells(i, 1))
End If
End If
Next i
If Not rngZ Is Nothing Then
Range("A1:A" & lngZ).Interior.Color = 10079487
rngZ.Interior.Color = 13408767
Set rngZ = Nothing
Else
MsgBox "Keine PLz gefunden"
End If
End Sub
Super Klasse von Dir ! Herzlichen Dank !!!!!!!!!!