VBA Programmierung für eine Zelle auf weitere Zellen erweite :: Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office

Einloggen, um private Nachrichten zu lesen

Downloads

[Excel 2003] VBA Programmierung für eine Zelle auf weitere Zellen erweite

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Autor

Nachricht

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 03.11.2008, 09:09

Hallo Zusammen,

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

Zitat:

Private Sub Worksheet_Change(ByVal Target As Range)
tst = Cells(1, 1).Value
ActiveSheet.Shapes("Ampel1").Select
If tst = "r" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 'rot
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
ElseIf tst = "y" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13 'gelb
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
ElseIf tst = "g" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17 ' grün
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Else
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1 ' xxx
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
End If
Range("A1").Select
End Sub

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 Cool

)

Hoffe jemand kann mir dabei helfen...

_________________
Klingt komisch, ist aber so...

miriki
Schlauberger

Anmeldedatum: 05.03.2007
Beiträge: 472
Wohnort: Kiel

Verfasst am: 03.11.2008, 09:42

davenport hat Folgendes geschrieben:

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.

Code:

tst = Cells(1, 1).Value
ActiveSheet.Shapes("Ampel1").Select

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

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 03.11.2008, 10:50

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.

Zitat:

Laufzeitfehler '2147024809 (80070057)':
Das Element mit dem angegebenen Namen wurde nicht gefunden.

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

Zitat:

ActiveSheet.Shapes("Ampel" & y).Select

Gelb markiert ist.

Hast du da noch eine Idee?

_________________
Klingt komisch, ist aber so...

miriki
Schlauberger

Anmeldedatum: 05.03.2007
Beiträge: 472
Wohnort: Kiel

Verfasst am: 03.11.2008, 11:40

davenport hat Folgendes geschrieben:

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

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 03.11.2008, 12:51

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.

_________________
Klingt komisch, ist aber so...

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 03.11.2008, 12:54

Hier nochmal das komplette Programm:

Zitat:

Private Sub Worksheet_Change(ByVal Target As Range)
For y = 1 To 50
tst = Cells(y, 1).Value
ActiveSheet.Shapes("Ampel" & Format$(y, "0")).Select
If tst = "r" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 'rot
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
ElseIf tst = "y" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13 'gelb
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
ElseIf tst = "g" Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17 ' grün
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Else
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1 ' xxx
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
End If
Range("a" & y).Select
Next y
End Sub

_________________
Klingt komisch, ist aber so...

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 03.11.2008, 13:12

Jetzt ist mir noch etwas aufgefallen.

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

_________________
Klingt komisch, ist aber so...

miriki
Schlauberger

Anmeldedatum: 05.03.2007
Beiträge: 472
Wohnort: Kiel

Verfasst am: 03.11.2008, 14:10

davenport hat Folgendes geschrieben:

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

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 03.11.2008, 14:30

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!*

_________________
Klingt komisch, ist aber so...

miriki
Schlauberger

Anmeldedatum: 05.03.2007
Beiträge: 472
Wohnort: Kiel

Verfasst am: 03.11.2008, 15:02

davenport hat Folgendes geschrieben:

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

Wobei das genau genommen 2 Probleme sind... Wink

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

davenport
Newbie
Newbie

Anmeldedatum: 03.08.2007
Beiträge: 20
Wohnort: Wiesbaden

Verfasst am: 04.11.2008, 14:53

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

_________________
Klingt komisch, ist aber so...

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Thema		Autor	Forum	Antworten	Verfasst am
Ähnliche Beiträge
	Serienbrief: Zelle aus Excel wird nic...	matze63	Microsoft Word Hilfe	2	09.01.2009, 12:50
	Serienbrief: Zelle aus Excel wird nic...	matze63	Microsoft Word Hilfe	0	09.01.2009, 12:48
	Hallo Leute, eine Formel für Prozente	willi1412	Microsoft Excel Hilfe	2	07.01.2009, 11:56
	Excel 2003 eine Zelle keine Berechnung	Schiffhexler	Microsoft Excel Hilfe	5	06.01.2009, 14:02
	(Exel 2003) 2 Tabellen vergleichen un...	michael62	Microsoft Excel Hilfe	5	04.01.2009, 12:08

Gehe zu:

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum posten
Du kannst Dateien in diesem Forum herunterladen

Powered by phpBB © 2001, 2002 phpBB Group :: FI Theme :: Alle Zeiten sind GMT + 1 Stunde
Deutsche Übersetzung von phpBB.de