# [Excel 2007] Makro mit variablen Zellen



## Darko82 (23. Januar 2010)

Hallöchen,

ich möchte aus bestimmten fixen Zellen sich ständig ändernde Werte "aufzeichnen", indem ich sie in andere Zellen kopiere und damit sichere. 

Die fixen Zellen sind:  

A8, A9,  und C9. Die Werte sollen nebeneinander in eine Zeile übertragen werden und zwar immer dann, wenn der Wert in Zelle C9 größer wird. Die Zeilen sollen im Ergebnis, von oben nach unten chronologisch mit den Werten aus den fixen Zeilen befüllt werden.

Ich habe dafür in jeder Zeile der Spalte E ab Zeile 8, die Formel (hier für E10): =WENN(UND(F10="";F9<>"";C$9>K9);1;"")

Die Formel lässt die Zeile in die der Werte abgetragen werden sollen eine 1 anzeigen.

Die 1 sollte nun das Makro starten, das die Werte in die entsprechende Zeile kopiert.

------------------------------
Option Explicit

Private Sub Worksheet_Calculate()

Dim x As Long
For x = 8 To 1000

    If Cells(5, x).Value = 1 Then


    Worksheets("Tabelle1").Cells(6, x) = Worksheets("Tabelle1").Cells(1, 8)
    Worksheets("Tabelle1").Cells(7, x) = Worksheets("Tabelle1").Cells(1, 9)

    Worksheets("Tabelle1").Cells(11, x) = Worksheets("Tabelle1").Cells(3, 9)


    Else
    Exit For
    End If
Next x

End Sub
---------------------------------------------

Ich hatte bisher noch nicht mit variablen Zellen und Schleifen zu tun, bei diesem Code tut sich jedenfalls nichts bei mir.
Kann mir jemand zeigen wie der richtige Code aussehen müsste?

Schönen Gruß,

Darko


----------



## Darko82 (23. Januar 2010)

Hab gerade gemerkt, dass ich Zeilen und Spalten vertauscht habe bei Cells.

Diesmal richtig rum, der Code funktioniert aber dennoch nicht:

------------------------------------------------

Option Explicit

Private Sub Worksheet_Calculate()

Dim x As Long
For x = 8 To 1000

    If Cells(x, 5).Value = 1 Then


    Worksheets("Tabelle1").Cells(x, 6) = Worksheets("Tabelle1").Cells(8, 1)
    Worksheets("Tabelle1").Cells(x, 7) = Worksheets("Tabelle1").Cells(9, 1)

    Worksheets("Tabelle1").Cells(x, 11) = Worksheets("Tabelle1").Cells(9, 3)


    Else
    Exit For
    End If
Next x

End Sub


----------



## Drogist (23. Januar 2010)

Moin,

es gibt da zwei Punkte, die uns allen helfen könnten:

Du sagst uns, WAS da nicht richtig läuft
Du formatierst den Code "vernünftig" und stellst ihn auch eingerückt hier ein.
Zu Punkt 2: Verwende bei den Icons die Raute (#), dann ist der Code übersichtlicher. Ich habe zusätzlich noch Zeilennummern eingefügt, da ich es für sinnvoll halte, dir einmal aufzuzeigen, was der Code da macht ... Ausführen natürlich ohne Zeilennummern ... 

Ich habe deinen Code noch etwas gekürzt und die Variable x in Ze umbenannt, das hilft vielleicht (Ze = Zeile).
Hier der Code:

```
01)  Option Explicit
02)  
03)  Private Sub Worksheet_Calculate()
04)  
05)    Dim Ze As Long
06)    For Ze = 8 To 1000
07)      If Cells(Ze, 5).Value = 1 Then
08)        Cells(Ze, 6) = Cells(8, 1)
09)        Cells(Ze, 7) = Cells(9, 1)
10)        Cells(Ze, 11) = Cells(9, 3)
11)     Else
12)       Exit For
13)     End If
14)   Next Ze
15) End Sub
```
Zeile 3: Immer bei einer Neuberechnung des Arbeitsblattes wird dieser Code ausgeführt
Zeile 6: Zeilen 8 .. 1000 werden "ausgewählt"
Zeile 7:   Wenn in der aktuellen Zeile Spalte E eine 1 steht ...
Zeile 8:     in die aktuelle Zeile Spalte F wird der Wert aus A8 geschrieben
Zeile 9:     in die aktuelle Zeile Spalte G wird der Wert aus A9 geschrieben
Zeile 10:   in die aktuelle Zeile Spalte K wird der Wert aus C9 geschrieben
Zeile 11: Sonst
Zeile 12:   verlasse die FOR-NEXT - Schleife
Zeile 14:  Gehe zur nächsten Zeile


Jetzt wir bei jeder Änderung (Calc) alles komplett durchgearbeitet. im schlimmsten Fall würden alle Zeilen 8 .. 999 neu beschrieben werden. Aber hoppla, da die auszulesenden Werte immer in den gleichen Zellen stehen, wirst du auch immer die identischen Ergebnisse untereinander stehen haben.

Du musst also eine weitere Variable erstellen, in welcher du die aktuelle Zeile hineinschreibst und dann so die Richtung

```
FOR Ze = AktuelleZeile + 1 TO 1000
```
Ich würde aber ohne die FOR - NEXT - Schleife auskommen. 
In Ze die aktuelle Zeile merken, nach dem Schreiben der Werte Ze um 1 erhöhen und dann abfragen, ob Ze >1000 ist Falls ja, Bye ...

Viel Glück!


----------



## Darko82 (24. Januar 2010)

Hallo Drogist,

vielen Dank für die ausführliche Antwort 

zu 1.: Es tut sich einfach nichts, es sollte ja die Werte kopieren aber es geschieht einfach nichts.
zu 2.: ich seh hier nirgends die Möglichkeit Code als solchen zu markieren, liegt vll am Gast-Status? Einrücken kann ich den Code jedenfalls künftig.


Wegen dieser deiner Befürchtung:

"...da die auszulesenden Werte immer in den gleichen Zellen stehen, wirst du auch immer die identischen Ergebnisse untereinander stehen haben."
Die Formel (hier für E10): =WENN(UND(F10="";F9<>"";C$9>K9);1;""), stellt sicher, dass sich zumindest ein Wert geändert haben muss, da ja C9>K9,also der Zeile darüber, sein muss. Mehr als eine Zelle gleichzeitig in der Spalte kann auch keine 1 anzeigen

Ich hab deinen Code mal übernommen, nachdem in E10 eine 1 durch die Formel erschien gab es jedoch keinerlei Reaktion.


Hatte auch diesen Code hier ausprobiert, leider ebenfalls ohne Reaktion:

---------------------------------------

Private Sub Worksheet_Calculate()

   Dim x As Long
   For x = 1 To 1000


       If Worksheets("Tabelle1").Cells(x, 5).Value = 1 Then


             Worksheets("Tabelle1").Cells(x, 6) = Worksheets("Tabelle1").Cells(8, 1)
             Worksheets("Tabelle1").Cells(x, 7) = Worksheets("Tabelle1").Cells(9, 1)

             Worksheets("Tabelle1").Cells(x, 11) = Worksheets("Tabelle1").Cells(9, 3)


    End If
Next x


End Sub
-----------------------------------------

Den letzten Teil von deiner Antwort kapier ich nicht so ganz

                     "Du musst also eine weitere Variable erstellen, in welcher du die aktuelle Zeile hineinschreibst und dann so die Richtung
                      Code:

                      FOR Ze = AktuelleZeile + 1 TO 1000

                      Ich würde aber ohne die FOR - NEXT - Schleife auskommen.
                      In Ze die aktuelle Zeile merken, nach dem Schreiben der Werte Ze um 1 erhöhen und dann abfragen, ob Ze >1000 ist Falls ja, Bye ..."



Hört sich aber danach an, dass das eine schnellere Lösung wäre, kannst du mir das vll noch näher erklären was da genau zu tun wäre?
Bräuchte ne Lösung die möglichst schnell arbeitet da sich die Werte in den fixen Zellen mehrmals in der Sekunde ändern können (DDE-Befüllung)

Kann es vll. sein dass man bei Calculate nicht mit variablen Arbeiten kann?


Gruß, Darko


----------



## Darko82 (24. Januar 2010)

Habs hingekriegt,  danke vielmals 

das "Exit for" musste noch raus aus der Formel von Drogist und Application auf False hinein, dann läufts wie gewünscht:
----------------------------------------------
Option Explicit

Private Sub Worksheet_Calculate()
Application.EnableEvents = False

Dim Ze As Long
For Ze = 8 To 1000
    If Cells(Ze, 5).Value = 1 Then
        Cells(Ze, 6) = Cells(8, 1)
        Cells(Ze, 7) = Cells(9, 1)
        Cells(Ze, 11) = Cells(9, 3)
    Else

    End If
    Next Ze

Application.EnableEvents = True
End Sub
-------------------------------------------

Falls es eine Lösung gibt die noch schneller arbeitet, lasst es mich wissen 

Gruß,Darko


----------



## Drogist (24. Januar 2010)

Hallo Darko,

vorweg bemerkt: Das mit dem Code-Format kann auch am Browser liegen, falls die Einstellungen keine Scripte erlauben.
Und: Ich habe deine Anforderung so Verstanden: Wenn in C9 ein neuer Wert drinnen steht und dieser größer ist als der vorherige, dann sollen in die Spalten F,G und K die drei Werte eingetragen werden.

Ob mein Code nun schneller ist, weiß ich nicht, aber auf jeden Fall kommt er ohne jeglich Hilfsspalte (deine Formel) aus:

```
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim r As Range
   Dim Ze As Integer
   
   If Target.Address = "$C$9" Then
      If Target.Value > 1 Then
         For Each r In Range(Cells(8, 11), Cells(1000, 11))
            If r.Value = "" Then
               Ze = r.Row
               If Target > Cells(Ze - 1, 11) Then
                  Cells(Ze, 6).Value = Cells(8, 1).Value
                  Cells(Ze, 7).Value = Cells(9, 1).Value
                  Cells(Ze, 11).Value = Cells(9, 3).Value
               End If
               Exit For
            End If
         Next r
      End If
   End If
End Sub
```
Füge diesen Code in das Arbeitsblatt ein und es wird klappen ...


----------



## Darko82 (24. Januar 2010)

Hallo Drogist,

Die Anforderung hast du richtig verstanden. Bei deiner letzten Formel tut sich leider nichts bei mir. Glaube es liegt an Worksheet_Change, das springt nur bei manuellen Änderungen an soweit ich weiss. 
Das macht aber nichts, da ich die Prüfung der Bedingung für den Makrostart aus Performance-Gründen weiter durch eine Hilfsspalte vornehmen will. Hab irgendwo gelesen, dass das schneller direkt im Blatt als durch ein Makro erledigt wird und Platz is spätestens ab Office 2007 genug da ;-)

Damit es noch schneller läuft, lasse ich mir jetzt die kopierenden Werte alle in einer Zeile anzeigen, so dass ich nur noch einmal einen Zellbereich kopieren muss, statt mehrere einzelne Zellen hintereinander.

Hab deinen Vorschlag aufgegriffen auf die Schleife zu verzichten, sind in Wahrheit 150000 Zeilen und nicht 1000, müsste dann nochmal schneller laufen. Lasse mir die Zeilenzahl der nächsten zu befüllenden Zeile jetzt im Blatt durch eine Formel anzeigen (L7):

----------------------------------------------------

Private Sub Worksheet_Calculate()
Application.EnableEvents = False

Dim Ze As Long
Ze = Range("L7")

    If Cells(Ze, 5).Value = 1 Then


    Range(Cells(Ze, 6), Cells(Ze, 11)).Value = Range(Cells(7, 6), Cells(7, 11)).Value


    End If


Application.EnableEvents = True
End Sub
--------------------------------------------

Eine noch schnellere Lösung wirds wohl nicht geben denk ich. Werden dann im Betrieb 15 solcher Codes sein, die jeweils 17 Spalten bis zu mehrere male in der Sekunde kopieren, da wird Excel ganz schön zu tun haben. Falls du eine Möglichkeit weisst solche Aufgaben iwie an ein externes Programm auszulagern lass es mich bitte wissen.

Herzlichen Dank jedenfalls soweit, hast mir sehr geholfen! 

Gruß,Darko


----------

