PDA

Vollständige Version anzeigen : Worksheet_Change au mehrere Zellen anwenden?


Chicken Wing
19.07.2012, 09:37
Hallo zusammen,

ich habe bei unten stehendem Code das Problem, das ich auf Tabelle1 verweisen möchte und von dort die Werte nehmen möchte. Weiterhin habe ich das Problem, das sich das Ganze auf mehrere Zellen wiederholt Ich habe die Datei mal angehangen. Die Werte, die ich nicht für die Berechnung brauche sind rot und die ich benötige sind grün markiert.
Wäre schön, wenn mir jemand helfen könnte.

Danke und Gruß
Chicken Wing

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Dim rngzelle As Range
'Bereich eingrenzen bei dem das Change Ereignis ausgelöst wird

Set rngBereich = Intersect(Target, Range("D3:J7"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Cells(1, Target.Column).Value
Next rngzelle
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

IngGi
19.07.2012, 11:37
Hallo Chicken Wing,

wenn es nur die 3 grünen Bereiche gibt, könntest du diese mit Union zusammenfassen:

<blockquote><div style='background-color: #F2F2FF; border: 1px solid #3300B2; padding: 0px 24px;'><pre style='font-size: 12px; padding: 0px 10px;'><span style="color: #0000FF">Private</span> <span style="color: #0000FF">Sub</span> Worksheet_Change<span style='color: #B200CC;'>(</span><span style="color: #0000FF">ByVal</span> Target <span style="color: #0000FF">As</span> Range<span style='color: #B200CC;'>)</span><br><br><span style="color: #0000FF">Dim</span> rngBereich <span style="color: #0000FF">As</span> <span style="color: #0000FF">Range<br></span><span style="color: #0000FF">Dim</span> rngZelle <span style="color: #0000FF">As</span> <span style="color: #0000FF">Range<br></span><span style='color: #008000;'>'Bereich eingrenzen bei dem das Change Ereignis ausgelöst wird<br></span><br><span style="color: #0000FF">Set</span> rngBereich = Intersect<span style='color: #B200CC;'>(</span>Target, <span style="color: #0000FF">Union</span><span style='color: #B200CC;'>(</span>Range<span style='color: #B200CC;'>(</span><span style='color: #CC9900;'>"D1:K5"</span><span style='color: #B200CC;'>)</span>, Range<span style='color: #B200CC;'>(</span><span style='color: #CC9900;'>"D9:K13"</span><span style='color: #B200CC;'>)</span>, Range<span style='color: #B200CC;'>(</span><span style='color: #CC9900;'>"D17:K21"</span><span style='color: #B200CC;'>)</span><span style='color: #B200CC;'>)</span><span style='color: #B200CC;'>)</span><br><br><span style="color: #0000FF">If</span> <span style="color: #0000FF">Not</span> rngBereich <span style="color: #0000FF">Is</span> <span style="color: #0000FF">Nothing</span> <span style="color: #0000FF">Then</span><br> <span style="color: #0000FF">On</span> <span style="color: #0000FF">Error</span> <span style="color: #0000FF">GoTo</span> ErrorHandler<br> Application.EnableEvents = <span style="color: #0000FF">False</span><br> <span style="color: #0000FF">For</span> <span style="color: #0000FF">Each</span> rngZelle <span style="color: #0000FF">In</span> rngBereich<br> rngZelle.Value = rngZelle.Value * Worksheets<span style='color: #B200CC;'>(</span><span style='color: #CC9900;'>"Tabelle1"</span><span style='color: #B200CC;'>)</span> _<br> .Cells<span style='color: #B200CC;'>(</span><span style="color: #FF0000">1</span>, Target.Column<span style='color: #B200CC;'>)</span>.Value<br> <span style="color: #0000FF">Next</span> rngZelle<br><span style="color: #0000FF">End </span><span style="color: #0000FF">If</span><br><br>ErrorHandler:<br>Application.EnableEvents = <span style="color: #0000FF">True</span><br><br><span style="color: #0000FF">End </span><span style="color: #0000FF">Sub</span><br></pre><hr style='color: #3300B2; background: #3300B2; height: 1px;'><p style='font-size: 8px; font-family: Verdana; text-align: right;'>VBA/HTML - CodeConverter für Excelforen<br>AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi<br>Anbindung an VBE-Kontextmenü geklaut ;-) bei: <a href='http://www.cpearson.com/excel/VbeMenus.aspx'>http://www.cpearson.com/excel/VbeMenus.aspx</a></p></div></blockquote>

Wenn es allerdings noch ein paar mehr "grüne Bereiche" sind, wird das Ganze schnell ziemlich sperrig. Dann würde ich die gültigen Zeilen eher über das Modulo bestimmen:

<blockquote><div style='background-color: #F2F2FF; border: 1px solid #3300B2; padding: 0px 24px;'><pre style='font-size: 12px; padding: 0px 10px;'><span style="color: #0000FF">Private</span> <span style="color: #0000FF">Sub</span> Worksheet_Change<span style='color: #B200CC;'>(</span><span style="color: #0000FF">ByVal</span> Target <span style="color: #0000FF">As</span> Range<span style='color: #B200CC;'>)</span><br><br><span style="color: #0000FF">On</span> <span style="color: #0000FF">Error</span> <span style="color: #0000FF">GoTo</span> ErrorHandler<br><span style='color: #008000;'>'Höchste Zeile anpassen, wenn mehr als die 3 Bereiche in deinem Beispiel<br></span><span style="color: #0000FF">For</span> <span style="color: #0000FF">Each</span> rngZelle <span style="color: #0000FF">In</span> Intersect<span style='color: #B200CC;'>(</span>Target, Range<span style='color: #B200CC;'>(</span><span style='color: #CC9900;'>"D1:K22"</span><span style='color: #B200CC;'>)</span><span style='color: #B200CC;'>)</span><br> <span style="color: #0000FF">If</span> rngZelle.Row Mod<span style="color: #FF0000"> 8</span> &gt;<span style="color: #FF0000"> 0</span> <span style="color: #0000FF">Then</span> <span style='color: #008000;'>'Nicht Zeile 8, 16, usw.<br></span> <span style="color: #0000FF">If</span> rngZelle.Row Mod<span style="color: #FF0000"> 8</span> &lt;<span style="color: #FF0000"> 6</span> <span style="color: #0000FF">Then</span> <span style='color: #008000;'>'Nicht Zeile 6/7, 14/15, usw.<br></span> Application.EnableEvents = <span style="color: #0000FF">False</span><br> rngZelle.Value = rngZelle.Value * Worksheets<span style='color: #B200CC;'>(</span><span style='color: #CC9900;'>"Tabelle1"</span><span style='color: #B200CC;'>)</span> _<br> .Cells<span style='color: #B200CC;'>(</span><span style="color: #FF0000">1</span>, Target.Column<span style='color: #B200CC;'>)</span>.Value<br> Application.EnableEvents = <span style="color: #0000FF">True</span><br> <span style="color: #0000FF">End </span><span style="color: #0000FF">If</span><br> <span style="color: #0000FF">End </span><span style="color: #0000FF">If</span><br><span style="color: #0000FF">Next</span> <span style='color: #008000;'>'rngZelle<br></span><br>ErrorHandler:<br>Application.EnableEvents = <span style="color: #0000FF">True</span><br><br><span style="color: #0000FF">End </span><span style="color: #0000FF">Sub</span><br></pre><hr style='color: #3300B2; background: #3300B2; height: 1px;'><p style='font-size: 8px; font-family: Verdana; text-align: right;'>VBA/HTML - CodeConverter für Excelforen<br>AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi<br>Anbindung an VBE-Kontextmenü geklaut ;-) bei: <a href='http://www.cpearson.com/excel/VbeMenus.aspx'>http://www.cpearson.com/excel/VbeMenus.aspx</a></p></div></blockquote>

Den Bezug auf Tabelle1 habe ich in beide Codes eingebaut.

Gruß Ingolf

Chicken Wing
19.07.2012, 17:58
Hallo,

eigentlich meinte ich das etwas anders.

Ich habe die Datei noch einmal erweitert und angehangen.

Mir geht es darum folgenden VBA-Code wesentlich zu verkürzen. Es gibt doch bestimmt eine Lösung, das ich das nicht für jede Zelle von Tabelle1 machen muß:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Dim rngzelle As Range
'Bereich eingrenzen bei dem das Change Ereignis ausgelöst wird

Set rngBereich = Intersect(Target, Range("D3:J3"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(1, Target.Column).Value
Next rngzelle
End If
ErrorHandler:
Application.EnableEvents = True

Set rngBereich = Intersect(Target, Range("D4:J4"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler2
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(2, Target.Column).Value
Next rngzelle
End If
ErrorHandler2:
Application.EnableEvents = True


Set rngBereich = Intersect(Target, Range("D5:J5"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler3
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(3, Target.Column).Value
Next rngzelle
End If
ErrorHandler3:
Application.EnableEvents = True

Set rngBereich = Intersect(Target, Range("D6:J6"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler4
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(4, Target.Column).Value
Next rngzelle
End If
ErrorHandler4:
Application.EnableEvents = True


Set rngBereich = Intersect(Target, Range("D7:J7"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler5
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(5, Target.Column).Value
Next rngzelle
End If
ErrorHandler5:
Application.EnableEvents = True


Set rngBereich = Intersect(Target, Range("D11:J11"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler6
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(7, Target.Column).Value
Next rngzelle
End If
ErrorHandler6:
Application.EnableEvents = True

Set rngBereich = Intersect(Target, Range("D12:J12"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler7
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(8, Target.Column).Value
Next rngzelle
End If
ErrorHandler7:
Application.EnableEvents = True

Set rngBereich = Intersect(Target, Range("D13:J13"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler8
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(9, Target.Column).Value
Next rngzelle
End If
ErrorHandler8:
Application.EnableEvents = True

Set rngBereich = Intersect(Target, Range("D14:J14"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler9
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(10, Target.Column).Value
Next rngzelle
End If
ErrorHandler9:
Application.EnableEvents = True

Set rngBereich = Intersect(Target, Range("D15:J15"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler10
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(11, Target.Column).Value
Next rngzelle
End If
ErrorHandler10:
Application.EnableEvents = True

End Sub


Danke und Gruß
Chicken Wing

Hajo_Zi
19.07.2012, 18:11
ohne Test.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Dim rngzelle As Range
'Bereich eingrenzen bei dem das Change Ereignis ausgelöst wird
Set rngBereich = Intersect(Target, Range("D3:J7"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(Rng.Row - 2, Target.Column).Value
Next rngzelle
End If
ErrorHandler:
Set rngBereich = Intersect(Target, Range("D11:J15"))
If Not rngBereich Is Nothing Then
On Error GoTo ErrorHandler6
Application.EnableEvents = False
For Each rngzelle In rngBereich
rngzelle.Value = rngzelle.Value * Worksheets("Tabelle1").Cells(Rng.Row - 4, Target.Column).Value
Next rngzelle
End If
ErrorHandler6:
Application.EnableEvents = True
End Sub


<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Hajo_Zi
19.07.2012, 19:21
kleinen Fehler noch Beseitigt.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Dim rngzelle As Range
'Bereich eingrenzen bei dem das Change Ereignis ausgelöst wird
Application.EnableEvents = False
Set rngBereich = Intersect(Target, Range("D3:J7"))
On Error GoTo ErrorHandler
If Not rngBereich Is Nothing Then
For Each rngzelle In rngBereich
rngzelle = rngzelle * Worksheets("Tabelle1").Cells(rngzelle.Row - 2, Target.Column)
Next rngzelle
Else
Set rngBereich = Intersect(Target, Range("D11:J15"))
If Not rngBereich Is Nothing Then
For Each rngzelle In rngBereich
rngzelle = rngzelle * Worksheets("Tabelle1").Cells(rngzelle.Row - 4, Target.Column)
Next rngzelle
End If
End If
ErrorHandler:
On Error GoTo 0
Set rngBereich = Nothing
Application.EnableEvents = True
End Sub

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Chicken Wing
23.07.2012, 08:24
Hallo noch einmal,

das funktioniert super. Allerdings muß ich noch mehrere Bereiche abdecken,
also mit if then else... ( eine Menge Bereiche :boah: ) Wie kann ich das denn verschachteln, das es funktioniert?

Vielen Dank und Gruß
Chicken Wing

Chicken Wing
23.07.2012, 18:11
keiner eine idee ???

Hajo_Zi
23.07.2012, 18:25
keine Idee, da keine genaue Aufgabe.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Chicken Wing
23.07.2012, 19:45
Hallo Hajo,

ich habe die Datei noch einmal angehängt. Ich meinte das so, das die Tabelle "Kino" bestimmt 1000 Reihen lang wird. Dementsprechend muß dann auch der VBA-Code so lang werden. Ich muß also für jeden Block eine IF Anweisung einbauen. Das sieht nicht nur bescheiden aus, sondern ist ein großer Aufwand. Jetzt wollte ich gerne wissen, ob es eine Möglichkeit, das Ganze eleganter zu gestalten, z.B. mit einer Case Anweisung oder so.

Gruß Chicken Wing

Hajo_Zi
24.07.2012, 04:55
Gut icfh kann damit Leben das Du keine genaue Aufgabenstellung liefern willst. Ich habe nicht das Problem.
Der erste Bereich hat -2, der zwweite Berreich hat -4, der 3 Bereich vielleicht -6?
Diese Zahl sollte man in den Zeilen in eine Spalte schreiben.
Ich bin aus o.g. raus.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Chicken Wing
24.07.2012, 08:30
Hallo Hajo,

die Aufgabenstellung bezieht sich eben darauf, das sehr viele IF Anweisungen im VBA Code stehen. Und meine Frage ist nun, ob die Möglichkeit besteht den VBA Code zu verkleinern, indem man die IF Anweisung beispielsweise mit dem Befehl CASE kürzen kann. Diese "Blöcke" in der Tabelle sollen weiter geführt werden. Diese Blöcke werden sich dann auf die jeweilige Woche beziehen. Da das Jahr ca. 52 Wochen hat und somit der VBA Code immer mit der IF Anweisung erweitert werden muß (-2, -4, -6, -8 usw. ) wird der ganze Code furchtbar unübersichtlich. Unten ist der Teilcode, um den es hauptsächlich geht.

Also, kann man den Code verkürzen und überschaubar machen?

Vielen Dank und Gruß
Chicken Wing


If Not rngBereich Is Nothing Then
For Each rngzelle In rngBereich
rngzelle = rngzelle * Worksheets("Tabelle1").Cells(rngzelle.Row - 2, Target.Column)
Next rngzelle
Else
Set rngBereich = Intersect(Target, Range("D11:J15"))
If Not rngBereich Is Nothing Then
For Each rngzelle In rngBereich
rngzelle = rngzelle * Worksheets("Tabelle1").Cells(rngzelle.Row - 4, Target.Column)
Next rngzelle
End If

Chicken Wing
26.07.2012, 09:25
*push:D