Microsoft Excel

Herbers Excel/VBA-Archiv

Makro wiederholen bis ...

Betrifft: Makro wiederholen bis ... von: Fritz_W
Geschrieben am: 03.11.2012 07:50:22

Hallo Forumsbesucher,

bitte um Hilfe der VBA-Experten unter euch.
In meiner Tabelle ändert sich bei Ausführung von Makro1 der Zellwert (Zahl) in Zelle O13. Ich möchte nun das Makro1 solange (wiederholt) ausführen lassen, bis der Zellwert in Zelle O13 die Zahl 0 annimmt.

Im Voraus vielen Dank für eure Unterstützung.

mfg
Fritz

  

Betrifft: Zeig doch bitte mal das Makro kwT von: Matthias L
Geschrieben am: 03.11.2012 08:06:18




  

Betrifft: AW: Zeig doch bitte mal das Makro kwT von: Fritz_W
Geschrieben am: 03.11.2012 08:24:42

Hallo Matthias,

hier das Makro:

Sub Makro1()
ScreenUpdating = False
Dim ArrayData, tmpArr, n&, nn&
With Tabelle2.Range("D14:L22")
    ArrayData = .Value
    tmpArr = .Offset(-10, 0).FormulaR1C1
    For n = 1 To UBound(ArrayData)
        For nn = 1 To UBound(ArrayData, 2)
            If ArrayData(n, nn) <> "" Then
                If IsNumeric(ArrayData(n, nn)) Then tmpArr(n, nn) = ArrayData(n, nn)
            End If
        Next nn
    Next n
    .Offset(-10, 0).FormulaR1C1 = tmpArr
ScreenUpdating = True
End With
End Sub
Der Zellwert in O13 ergibt sich aus einer Formel.

mfg
Fritz


  

Betrifft: Und die Formel aus O6 ? von: Matthias L
Geschrieben am: 03.11.2012 08:50:09

Hallo

Dein Makro kopiert doch nur den Inhalt aus Range("D14:L22")
und fügt es 10 Zeilen weiter oben wieder ein.

Das kann man doch auch so machen:

With Tabelle2
.Range("D14:L22").Copy
.Range("D4").PasteSpecial Paste:=xlPasteValues
 Application.CutCopyMode = False
End With
Was in "O6" steht weis ich nicht, also kann ich Dir ja nicht gezielt helfen.

Nur soviel dazu:
Du kannst Dein Makro ja wiederholen und Goto bzw. Do verwenden.
hier beide Beispiele in einer Datei:

https://www.herber.de/bbs/user/82459.xls

viel Erfolg
Gruß Matthias (muss jetzt weg)


  

Betrifft: AW: Und die Formel aus O6 ? von: Fritz_W
Geschrieben am: 03.11.2012 09:09:05

Hallo Matthias,

vielen Dank.

Werd im Verlauf des heutigen Nachmittags probieren, ob ich aus der Beispieldatei die richtigen Schlüsse ziehen kann, ich hab da aber meine Zweifel.
Der Zellwert in O13 ändert sich nach jeder Ausführung des Makros, deshalb meinte ich es ist unerheblich was in O6 steht. Also das Makro1 solange ausführen, bis in O6 eine 0 steht.
Ggf. melde ich mich später noch einmal.

mfg
Fritz


  

Betrifft: AW: Und die Formel aus O6 ? von: Tino
Geschrieben am: 03.11.2012 09:16:56

Hallo,
soll dieses Makro in einer Schleife bleiben oder immer wieder neu gestartet werden.

Mit Schleife müsste so gehen.

Sub Makro1()
Dim ArrayData, tmpArr, n&, nn&
Application.ScreenUpdating = False
With Tabelle2.Range("D14:L22")
    Do While Tabelle2.Range("O13") > 0
        ArrayData = .Value
        tmpArr = .Offset(-10, 0).FormulaR1C1
        For n = 1 To Ubound(ArrayData)
            For nn = 1 To Ubound(ArrayData, 2)
                If ArrayData(n, nn) <> "" Then
                    If IsNumeric(ArrayData(n, nn)) Then tmpArr(n, nn) = ArrayData(n, nn)
                End If
            Next nn
        Next n
        .Offset(-10, 0).FormulaR1C1 = tmpArr
    Loop
End With
Application.ScreenUpdating = True
End Sub
Immer wieder neu starten geht so.

kommt als Code in DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
On Error Resume Next 
Application.OnTime nTime, "Makro1", Schedule:=False 
End Sub 
 
kommt als Code in Modul1
Option Explicit 
 
Public nTime As Date 
 
Sub Makro1() 
Dim ArrayData, tmpArr, n&, nn& 
 
Application.ScreenUpdating = False 
With Tabelle2.Range("D14:L22") 
    ArrayData = .Value 
    tmpArr = .Offset(-10, 0).FormulaR1C1 
    For n = 1 To Ubound(ArrayData) 
        For nn = 1 To Ubound(ArrayData, 2) 
            If ArrayData(n, nn) <> "" Then 
                If IsNumeric(ArrayData(n, nn)) Then tmpArr(n, nn) = ArrayData(n, nn) 
            End If 
        Next nn 
    Next n 
    .Offset(-10, 0).FormulaR1C1 = tmpArr 
End With 
 
Range("O13") = Range("O13") - 1 
Application.ScreenUpdating = True 
 
If Tabelle2.Range("O13") > 0 Then 
    nTime = Now + TimeSerial(0, 0, 1) 
    Application.OnTime nTime, "Makro1" 
End If 
End Sub 
Gruß Tino


  

Betrifft: AW: Und die Formel aus O6 ? von: Tino
Geschrieben am: 03.11.2012 09:18:38

Hallo,
im zweiten Code die Zeile

Range("O13") = Range("O13") - 1

löschen, hatte ich zu testzwecken reingeschrieben.

Gruß Tino


  

Betrifft: AW: Und die Formel aus O6 ? von: Fritz_W
Geschrieben am: 03.11.2012 09:34:30

Hallo Tino,

mit Schleife funktioniert es genau so, wie ich mir das vorgestellt habe!
Ganz herzlichen Dank.

Viele Grüße
Fritz


P.S.: Den in Makro1 verwendeten Code hab ich übrigens hier in diesem Forum von Dir erhalten.


  

Betrifft: AW: Und die Formel aus O6 ? von: Tino
Geschrieben am: 03.11.2012 09:41:23

Hallo,
kann mich daran erinnern, daher wusste ich das es mit kopieren nicht geht.
Weil die Formeln im Ziel erhalten bleiben müssen und nur
Nummerische Daten übertragen werden sollen.

Erich hat auch noch eine Variante reingestellt.

Gruß Tino


  

Betrifft: AW: Und die Formel aus O6 ? von: Fritz_W
Geschrieben am: 03.11.2012 10:29:55

Hallo Tino,

Du hast mir hier in den vergangenen Monaten schon mehrfach mit ganz excellenten Lösungen geholfen.
Wie ich schon (auf Erichs letzten Beitrag) erwähnt hab, bin ich sehr dankbar für die Hilfe von solchen Könnern.

Viele Grüße
Fritz


  

Betrifft: Codevorschlag von: Erich G.
Geschrieben am: 03.11.2012 09:33:06

Hi Fritz,
hier mein Vorschlag:

Option Explicit

Sub Makro1()
   Dim rngQuel As Range, rngZiel As Range, rngTest As Range
   Dim arQuel, arZiel, zz As Long, ss As Long, ii As Integer

'   Application.ScreenUpdating = False             ' NACH dem Test aktivieren
   With Tabelle2
      Set rngQuel = .Range("D14:L22")
      Set rngZiel = rngQuel.Offset(-10, 0)
      Set rngTest = .Range("O13")
      Do While ii < 9999                           ' ii-Grenze als Notbremse
         If rngTest.Value = 0 Then Exit Do
         ii = ii + 1
         arQuel = rngQuel.Value
         arZiel = rngZiel.FormulaR1C1
         For zz = 1 To UBound(arQuel)
            For ss = 1 To UBound(arQuel, 2)
               If arQuel(zz, ss) <> "" Then
                  If IsNumeric(arQuel(zz, ss)) Then arZiel(zz, ss) = arQuel(zz, ss)
               End If
            Next ss
         Next zz
         rngZiel.FormulaR1C1 = arZiel
      Loop
   End With
   Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: Codevorschlag von: Fritz_W
Geschrieben am: 03.11.2012 09:42:48

Hallo Erich,

auch mit deinem Code funktioniert es wie ich mir das vorgestellt habe.
Auch Dir ganz herzlichen Dank.

Viele Grüße
Fritz


  

Betrifft: kleine Änderung von: Erich G.
Geschrieben am: 03.11.2012 09:54:21

Hi Fritz,
je nach der Formel in O13 (bzw. deren möglichen Werten) kann es nützlich sein,
die Exit-Bedingung sicherheitshalber etwas anders formulieren.

Wenn aufgrund der Dazimalzahl-Rechenungenauigkeit in O13 nicht genau 0,
sondern nur ein Wert nahe bei 0 rauskommt, sollte die Schleife wohl auch abbrechen - also:
If Abs(rngTest.Value) < 0.000000000001 Then Exit Do

Wenn in O13 nur Ganzzahlen rauskommen können, gibts natürlich da keine Probleme.
Nebenbei: In Tinos Code erfolgt der Abbruch auch, wenn O13 kleiner als 0 ist.

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: kleine Änderung von: Fritz_W
Geschrieben am: 03.11.2012 10:22:38

Hallo Erich,

ich bin immer wieder begeistert, welche hilfreichen (ergänzende) Informationen mir hier in diesem Forum immer wieder zur Verfügung gestellt werden.
Ich möchte mich dafür hier noch einmal ganz herzlich bei Dir und allen anderen Helfern bedanken.

Viele Grüße
Fritz


  

Betrifft: Das es eine Vorgeschichte gab wusste ich nicht kwT von: Matthias L
Geschrieben am: 03.11.2012 17:54:58




 

Beiträge aus den Excel-Beispielen zum Thema "Makro wiederholen bis ..."