Office: VBA Programmierung für eine Zelle auf weitere Zellen erweite

Hallo Zusammen,

ich habe ein kleines Problem, ich soll eine Ampelfunktion in Excel erzeugen, und bin auf folgende Lösung gestoßen:

Nur leider ist hier das Problem, dass ich nicht weiß wie man in VBA das so programmiert dass man jeweils das Feld A2, A3, A4, A5, usw. mit der Ampel2, Ampel3, Ampel4, usw. verknüpft. (ich habe das Programm im web gefunden und ein bissi korregiert - die letzte "else-Funktion" hinzugefügt und die Farbe 1 herausgefunden über try'n error )

Hoffe jemand kann mir dabei helfen...

 

Re: VBA Programmierung für eine Zelle auf weitere Zellen erw

Hier wird Zelle "A1" benutzt und mit "Ampel1" gearbeitet.

Wenn Du z.B. A1..5 mit Ampel1..5 benutzen möchtest, könnte gehen:

Code:

for y=1 to 5
tst = Cells(y, 1).Value
ActiveSheet.Shapes("Ampel" & y).Select
[...]
range("a" & y).select
next y

Gruß, Michael

 

Hallo Michael,

habe deinen Vorschlag ausprobiert, nur es erscheint ein Fehler (danach funktioniert es aber)
Der Fehler erscheint nachdem ich in den Feldern A1...A5 etwas ändere.

wenn ich dann auf "Beenden" klicke wird die Ampelschaltung bei allen elementen gemacht.

Wenn ich dagegen auf "Debuggen" klicke, kommt das VBA-Fenster in dem die Zeile

Gelb markiert ist.

Hast du da noch eine Idee?

 

So jetzt, anhand Deiner Beschreibung... ähm... eher nicht.

Die Zeile, die markiert wird bei "Debuggen", ist die, die dafür verantwortlich ist, daß in den nächsten Zeilen ("Selection...") die entsprechende "Ampel" angesprochen wird. Kann die nicht angewählt werden, dürften sich auch die entsprechenden Farben nicht ändern.

Und bei "Beenden" sollte die Routine ebenfalls kpl. abgebrochen werden und es dürften sich keine Farben ändern.

Von daher stehe ich gerade etwas verdutzt in der Gegend herum.

Andere Schreibweisen, die das "y", was ja eigentlich eine Zahl ist, etwas sauberer mit dem String "Ampel" verbinden, wären:

Code:

ActiveSheet.Shapes("Ampel" & trim$(str$(y))).Select

oder

Code:

ActiveSheet.Shapes("Ampel" & format$(y,"0")).Select

Ich glaub zwar nicht, das sich dadurch was ändert, aber versuchen kannst Du es ja mal.

Ähm, Moment... Ich glaube... *patsch*

Du schriebst in Deinem ersten Posting was von Ampel 2 bis 5 und ich hab einfach mal angenommen, Die Ampel 1 gehört nach wie vor dazu. Sollte die 1 wirklich nicht dabei sein, dann ändere einfach

Code:

for y=2 to 5

damit die Zählung erst bei 2 beginnt und bis 5 läuft.

Gruß, Michael

 

Richtig Ampel 1 soll zu den anderen dazugehören.
Das ganze soll im Moment 35 Ampeln haben (bis 12 habe ich es schon erweitert)

Aber ich habe eben bemerkt, wenn ich in dem A1 feld oder in einem anderen was ändere, dann wird die Farbe geändert und dann kommt diese Fehlermeldung wie oben beschrieben.

 

Hier nochmal das komplette Programm:

 

Jetzt ist mir noch etwas aufgefallen.

wenn ich irgendwo in dem Blatt eingaben mache, kommt immer diese Fehlermeldung und die Auswahl Beenden oder Debuggen...

 

Das Ereignis (und dementsprechend auch der Fehler, der in diesem Ereignis produziert wird) wird immer dann ausgelöst, wenn sich im Blatt (durch manuelle Eingabe) etwas ändert. Deswegen heißt das Ereignis auch "Change", siehe erste Zeile mit "Sub ...". Insofern ist es ersteinmal egal, ob sich was an den Werten ändert, die mit den Ampeln zu tun haben, oder irgendwo ganz woanders.

Es gibt aber eine Möglichkeit, die Routine nur dann durchlaufen zu lassen, wenn sich in einer "relevanten" Zelle was geändert hat. Dazu wird überprüft, ob der Parameter "target", der den geänderten Bereich (sinnvollerweise: ein range() mit genau einer Zelle) enthält, sich mit dem Bereich überschneidet, der die "relevanten" Zellen beinhaltet. Ist die Schnittmenge >0, dann wird der Rest der Routine abgearbeitet, ansonsten nicht, weil die Änderung sich irgendwo anders abgespielt hat.

Ich krieg jetzt bloß so aus'm Stegreif die Syntax mit dem .intersect nicht mehr so ganz hin.

Aber zurück zu dem ursprünglichen Problem: Die Schleife mit y darf nur den Bereich durchlaufen, für den es auch die dazugehörigen Shapes gibt. Wenn Du also Deine Schleife jetzt von 1 bis 50 laufen läßt, aber nur die Ampeln (das sind die Shapes) von 1 bis 35 auf dem Blatt platziert hast, dann kracht es genau bei dem Versuch, wenn die Schleife bei 36 angekommen ist, eben weil es kein Shape namens "Ampel36" gibt.

Gruß, Michael

 

Genial Michael!!!

jetzt funktioniert es genau wie gewollt.

Aber du hast schon das nächste Problem, was ein arbeiten damit unangenehm macht, angesprochen.

nach jeder eingabe - egal in welchem Feld, durchläuft er die Felder A1 bis A12 und bleibt in dem Feld A12 stehen.

Naja, wenn dir da noch was einfallen würde, wäre ich dir sehr dankbar!

Grüße Dave


*Ich werde heute noch bei meinem Chef einen VBA-Kurs beantragen!*

 

Wobei das genau genommen 2 Probleme sind... ;-)

Das erste läßt sich sehr leicht erledigen: Setze vor die Zeile gegen Ende
Range("a" & y).Select
einfach ein ' (Hochkomma) und mache damit aus der Zeile einen Kommentar. Sinn: Bei jeder Abarbeitung wird durch diese Zeile der Cursor auf die jeweilige Zelle platziert. Das ist nicht gerade schön im "Change" Ereignis. In dem Ereignis sollta man möglichst komplett auf "Select" und "Activate" verzichten. Es ist nämlich ziemlich nervig, nach jeder Bearbeitung erstmal zu gucken, wohin der Cursor denn jetzt schon wieder verschwunden ist, um ihn dann auf die nächste Zelle zu setzen, in der man arbeiten will.

Alternative: Nach "next y" könnte man ein

Code:

if range(target).cells.count=1 then
range(target).activate
endif

setzen, um den Cursor nach dem ganzen Gedaddel wieder dorthin zu setzen, wo die letzte Änderung stattfand. Ist aber auch nicht ganz ohne Schönheitsfehler, denn die zuletzt bearbeitete Zelle ist nicht unbedingt die, wo der Cursor nach der Bearbeitung zuletzt stand (Stichwort: Return gedrückt...)

Das andere Problemchen... Schau Dir mal Folgendes an:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Const wks = "Tabelle1"
    Const rng = "A1:A35"

    Dim Source As Range

    Set Source = Worksheets(wks).Range(rng)

    If Not (Application.Intersect(Source, Target) Is Nothing) Then
        MsgBox "Änderung in " & rng
    End If

End Sub

Hier wird eine msgbox ausgegeben, wenn in dem betreffenden Bereich eine Änderung vorgenommen wird. Der Bereich wird durch die Konstanten wks (worksheet) und rng (range) festgelegt. Alles innerhalb von IF .. ENDIF wird nur ausgeführt, wenn die Änderung in dem Bereich passierte, der "überwacht" werden soll.

Zum Ausprobieren pack den Code doch mal in den Blatt-Source einer leeren Mappe. Danach änder mal ein bißchen im Bereich A1:A35 und außerhalb die Werte in den Zellen.

Kriegst Du das auf Deine bisherige Routine übertragen?

Gruß, Michael

 

Hi Michael,

vielen Dank für deine Hilfe. Diese Thematik überfordert mich doch ein wenig.

Habe heute den ganzen Tag versucht es einzufügen, aber so ganz hat es nicht geklappt. Und bevor ich deine ganze Zeit verplember, lass ich es erstmal und mache es über bedingte Formatierung - nicht sehr schön aber es funzt einfach...

Danke!

Grüße Dave