Zahlenreihen ändern VBA

Computer: Software & Programmierung Office Software
1

Hallo liebe Exelianer und Makroten

Ich habe zwei Zahlenreihen für monatliche Berechnungen im Zusammenhang mit einer Liquiditätsplanung (Kasse und Bank), verteilt auf je zwei Zellbereiche. Ich habe die Datei hochgeladen. Sie ist in Excel 2010 erstellt worden, wurde aber als xls gespeichert, damit sie auch ältere Generationen lesen können :wink:
http://www.file-upload.net/download-4526613/Zell_Inh…

Wenn ich in irgendeinem Monat eine Zahl eingebe, soll diese Zahl auch in den Folgemonaten übernommen werden. Dazu habe ich ein Makro (in der Arbeitsmappe) geschrieben.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
If Intersect(Target, Range(„B2:H3“, „B6:H7“)) Is Nothing Then Exit Sub

tc = Target.Column
tr = Target.Row

If tr = 4 Or tr = 5 Then Exit Sub

'Problem:
'If tc > 7 Then GoTo Zeile2

veraenderung = Cells(tr, tc)
Cells(tr, tc + 1) = veraenderung

Zeile2:
If tr 7 Then GoTo Zeile2

Damit klappt es grundsätzlich; aber nicht bei Eingaben in den Zellen H2 bzw. H3. Deshalb habe ich diesen Makroteil „ausgeschaltet“. Statt dessen habe ich am Ende des Makros unter „Bereinigung:“ ganz radikal eingesetzt:
Range(„I2:I3“, „I6:I7“) = „“

Das gefällt mir nicht. Das ist mir zu martialisch. Erinnert zu stark an Steinbrücks Kavallerie - gg. Dafür gibt es sicher eine elegantere Lösung. Kann mir jemand von Euch helfen?

Und überhaupt: Ich vermute, man kann dieses Makro viel professioneller schreiben. Zum Beispiel gefallen mir die vielen „if“ überhaupt nicht.

Vielen Dank für Euer Interesse und Eure Bemühungen.
Ich wünsche eine gute neue Woche und grüsse Euch
Niclaus

2

http://www.file-upload.net/download-4526613/Zell_Inh…

Wenn ich in irgendeinem Monat eine Zahl eingebe, soll diese
Zahl auch in den Folgemonaten übernommen werden. Dazu habe ich
ein Makro (in der Arbeitsmappe) geschrieben.

Hallo Niclaus,

vielleicht so:

Option Explicit

Private Sub Worksheet\_Change(ByVal Target As Range)
Dim Spa As Long, tr As Long, tc As Long
Set Target = Intersect(Target, Range("B2:H3", "B6:H7"))
If Target Is Nothing Then Exit Sub
If Target.Count \> 1 Then Exit Sub
Application.EnableEvents = False
tr = Target.Row
tc = Target.Column
Do
 For Spa = tc + 1 To 8
 Cells(tr, Spa).Value = Target.Value
 Next Spa
 tc = 1
 tr = tr + 4
Loop While tr 

Gruß
Reinhard
3

Hallo Niclaus,

wenn ein Change-Ereignismakro andere Zellen ausfüllen soll, dann sollten die Ereignismakros vorübergehend deaktiviert werden.

Viele If-Anweisungen kann man oft durch eine „Select Case“-Konstruktion ersetzen. ist hier aber nicht erforderlich.

Gruß
Franz

Private Sub Worksheet\_Change(ByVal Target As Range)
 Dim tc As Long, tr As Long

 If Not Intersect(Target, Range("B2:H3", "B6:H7")) Is Nothing \_
 And Target.Cells.Count = 1 Then

 Application.EnableEvents = False
 tc = Target.Column
 tr = Target.Row
 veraenderung = Cells(tr, tc)
 With Range(Cells(tr, tc), Cells(tr, 8))
 .Value = veraenderung
 If tr = 2 Or tr = 3 Then .Offset(4, 0).Value = veraenderung
 End With
 Application.EnableEvents = True
 End If
End Sub
4

Hallo Franz
Vielen Dank! - Zwei Sachen habe ich zu Deinem Makro:

A) Eine Eingabe in den Zellen B4:H5 führt das Makro auch aus. Das soll aber nicht sein.
Deshalb habe ich nach
tr = Target.Row
tc = Target.Column
folgendes eingesetzt:

If tr = 4 Or tr = 5 Then
Application.EnableEvents = True
Exit Sub
End If

Ein GoTo zur drittletzten Zeile im Makro bringt’s auch.

Dazu eine Frage: Ist die Bereichsfestsetzung
Intersect(Target, Range(„B2:H3“, „B6:H7“))
nicht optimal? Es schaut so aus, wie wenn das Makro interpretiert:
Range(„B2:H7“)

Ich habe x mal das Excel neu starten müssen, bis ich realisiert habe, dass ich Application.EnableEvents = True setzen muss. - Aus Fehlern lernt man!

B) Eine Eingabe z. B. in E2 füllt zwar E6:H6 aus, nicht aber B6:smiley:6.
Das offset(4,0) ist da wohl schuld dran. Ich habe es versucht mit offset(4,-tc+2). Das füllt dann zwar B6:E6 aus, nicht aber F6:H6.
Ich mache es nun so:
If tr = 2 Or tr = 3 Then
Range(Cells(tr + 4, 2), Cells(tr + 4, 8)).Value = veraenderung
End If
Eine Lösung mit Offset wäre viel eindrücklicher!

Noch einmal ein herzliches Dankeschön und viele Grüsse
Niclaus

5

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Spa As Long, tr As Long, tc As Long
Set Target = Intersect(Target, Range(„B2:H3“, „B6:H7“))
If Target Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
tr = Target.Row
tc = Target.Column
Do
For Spa = tc + 1 To 8
Cells(tr, Spa).Value = Target.Value
Next Spa
tc = 1
tr = tr + 4
Loop While tr

Grüezi Reinhard

Auch Dir vielen Dank. Dein Makro haut hin! Nur eine Kleinigkeit - ähnlich wie bei Franz:

Eine Eingabe in den Zellen B4:H5 führt das Makro auch aus. Das soll aber nicht sein.
Deshalb habe ich nach
tr = Target.Row
tc = Target.Column
folgendes eingesetzt:

If tr = 4 Or tr = 5 Then
Application.EnableEvents = True
Exit Sub
End If

Ein GoTo zur zweitletzten Zeile im Makro wäre auch möglich.

Dazu eine Frage: Ist die Bereichsfestsetzung
Intersect(Target, Range(„B2:H3“, „B6:H7“))
nicht optimal? Es schaut so aus, wie wenn das Makro interpretiert:
Range(„B2:H7“)

Ich habe x mal das Excel neu starten müssen, bis ich realisiert habe, dass ich Application.EnableEvents = True setzen muss. - Aus Fehlern lernt man!

Noch einmal herzlichen Dank!
Viele Grüsse und schlaf gut
Niclaus

6

Grüezi Niclaus,

Eine Eingabe in den Zellen B4:H5 führt das Makro auch aus. Das
soll aber nicht sein.

okay, haste erwähnt aber ich habe das nicht beachtet. Ich wußte nicht
daß das so ist, sorry

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Spa As Long, tr As Long, tc As Long, Bereich as range
set bereich=union(Range(„B2:H3“),range(„B6:H7“))
Set Target = Intersect(Target, Bereich)

probiere bitte mal das. Wenn ich Codezeilen mit kleinschrift reinsetze
so sind die ungetestet. Ggfs. korrigieren wenn ich wiedermal
Schreibfehler drin habe :smile:

Ein GoTo zur zweitletzten Zeile im Makro wäre auch möglich.

Vermeide bitte GoTos. Okay ist ein Goto bei Fehlern,
ein Goto zu einer bei größeren Codes immer nötigen Fehlerbehandlung.
Google mal nach „Errorhandler“, das sit kein von Excel festgelegter
Name aber sehr viele, Vba-Sprache ist englisch, benutzen das als name.

Ich kenne persönlich nur eine Ausnahme wo man geballt GoTos einsetzt,
sogar einsetzen muß. Das sind Programme die zig Milliarden
Kombinationen durchprüfen müssen.
Geschickt eingesetzt kann man dann dadurch den Code enorm
beschleunigen, der läuft dann nicht 23 Tage sondern nur noch 12
Stunden :smile:

Aber im Normalfall ist Code mit GoTos schwer zu lesen und
nachzuvollziehen. Also verzichte bitte darauf sofern möglich.

Dazu eine Frage: Ist die Bereichsfestsetzung
Intersect(Target, Range(„B2:H3“, „B6:H7“))
nicht optimal? Es schaut so aus, wie wenn das Makro
interpretiert: :Range(„B2:H7“)

du hast getestet, ich glaub dir :smile:
Wenn das so ist und Inersect keinen Parameter hat ist das wohl so.

Ich habe x mal das Excel neu starten müssen, bis ich
realisiert habe, dass ich Application.EnableEvents = True
setzen muss. - Aus Fehlern lernt man!

Ja, mußte ich auch durch, grad auch bei EnableEvents *grins*.
Da ist man so mit dem Codieren beschäftigt und dann dauert es
durchaus lange Zeit bis man auf die Idee kommt da mal mit
einer einzeiligen Sub wieder Enablevents auf True zu setzen.
Denn, üblicherweise hat man die Nichtfunktion seines Codes erstmal
im Code vermutet.

Gruß
Reinhard

7

Dim … Bereich as range
set bereich=union(Range(„B2:H3“),range(„B6:H7“))
Set Target = Intersect(Target, Bereich)
probiere bitte mal das.
…
Wenn das so ist und Intersect keinen Parameter hat ist das wohl so.

Das war die Lösung.
Das mit GoTo merke ich mir. Aber trotzdem: Now I GoTo a beer :wink:)
Herzlichen Dank und viele Grüsse
Niclaus

8

Das mit GoTo merke ich mir. Aber trotzdem: Now I GoTo a beer
:wink:)

Hallo Niclaus,

kein Akt das zu codieren:

Do
 If you not had a beer
 order one beer
 else
 take another beer
 End if
Loop while Head not crashs on Table Or Head not crashs on floor

-))

Gruß
Reinhard

9

Hallo Niclaus,

ich hatte nicht getestet, ob die Intersect-Methode korrekt ist. Hier müssen dann 2 Anweisungen mit Or geprüft werden. Oder man stellt das ganze auf Prüfungen von Spalten und Zeilen-Nummer der Target-Zelle um.

Bei Einträgen in Zeilen 2 und 3 hatte ich übersehen, dass der Wert immer in aller Zellen in den Zele 6 bzw. 7 eingetragen werden soll.

Mit Offset zu den Zeile 2 bzw. 3 sieht das Makro dann wie folgt aus.

Gruß
Franz

Private Sub Worksheet\_Change(ByVal Target As Range)
 Dim tc As Long, tr As Long

 If (Not Intersect(Target, Range("B2:H3")) Is Nothing \_
 Or Not Intersect(Target, Range("B6:H7")) Is Nothing) \_
 And Target.Cells.Count = 1 Then

 Application.EnableEvents = False
 tc = Target.Column
 tr = Target.Row
 veraenderung = Cells(tr, tc)
 Range(Cells(tr, tc), Cells(tr, 8)).Value = veraenderung
 If tr = 2 Or tr = 3 Then
 Range(Cells(tr, 2), Cells(tr, 8)).Offset(4, 0).Value = veraenderung
 End If
 Application.EnableEvents = True
 End If
End Sub

'oder

Private Sub Worksheet\_Change(ByVal Target As Range)
 Dim tc As Long, tr As Long
 With Target
 If .Cells.Count = 1 Then
 Select Case .Row
 Case 2, 3, 6, 7
 Select Case .Column
 Case 2 To 8
 Application.EnableEvents = False
 tc = .Column
 tr = .Row
 veraenderung = Cells(tr, tc)
 Range(Cells(tr, tc), Cells(tr, 8)).Value = veraenderung
 If tr = 2 Or tr = 3 Then
 Range(Cells(tr, 2), Cells(tr, 8)).Offset(4, 0).Value = veraenderung
 End If
 Application.EnableEvents = True
 End Select
 End Select
 End If
 End With
End Sub
10

Hallo Niclaus,
Mit Offset zu den Zeile 2 bzw. 3 sieht das Makro dann wie
folgt aus.

Hallo Franz
Ich bin erst jetzt dazugekommen, Deine beiden Makros zu testen und anzuschauen. Es funktionieren beide hervorragend! Ganz herzlichen Dank für Deine Mühe.
Ich verstehe die beiden Makros noch nicht richtig. In einer Woche habe ich Urlaub, da habe ich Zeit, mich in sie hinein zu vertiefen!!
Noch einmal herzlichen Dank und liebe Grüsse
Niclaus