2 (evtl. 3) Schleifen in einem Makro

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Alex,
etwa in der folgenden Form.
Auf jeden Fall sollte es ein Start sein.
Gruß
Franz

Sub aaaTest()
Dim varWert_D As Variant
Dim Zeile_D As Long, Zeile_D1 As Long, Zeile_DE As Long
Dim Zeile_M As Long, Zeile_M1 As Long, Zeile_ME As Long
Dim Zeile_Erg1 As Long, Spalte_Erg As Long, Zeile_ErgE As Long, rngErgebnis As Range
Dim wks As Worksheet
Set wks = ActiveWorkbook.Worksheets("Tabelle1")
With wks
'Zeilen ermitteln/setzen
Zeile_D1 = 13: Zeile_M1 = 13
Zeile_DE = .Range("D12").End(xlDown).Row 'in D12 muss ein Inhalt stehen!!
Zeile_ME = .Range("M12").End(xlDown).Row 'in M12 muss ein Inhalt stehen!!
If Zeile_DE > 32 Then
MsgBox "Keine Daten in Spalte D"
Exit Sub
End If
If Zeile_DM > 32 Then
MsgBox "Keine Daten in Spalte M"
Exit Sub
End If
'Zellbereich mit Ergebnissen setzen = der Zellbereich in den "mein_makro"
Zeile_Erg1 = 13
Zeile_ErgE = 32  ' letzte Ergebniszeile - fix oder dynamisch?
Spalte_Erg = 16 'Spalte P
Set rngErgebnis = .Range(.Cells(Zeile_Erg1, Spalte_Erg), .Cells(Zeile_ErgE, Spalte_Erg))
'alte Ergebnisse löschen
rngErgebnis.Offset(0, 1).Resize(Zeile_ErgE - Zeile_Erg1 + 1, 400).Clear
For Zeile_D = Zeile_D1 To Zeile_DE
varWert_D = .Cells(Zeile_D, 4).Value 'Werte in Splate D merken
For Zeile_M = Zeile_M1 To Zeile_ME
'Wert aus M in D eintragen
.Cells(Zeile_D, 4).Value = .Cells(Zeile_M, 13).Value
Call mein_makro
Spalte_Erg = Spalte_Erg + 1
rngErgebnis.Copy
With .Range(.Cells(Zeile_Erg1, Spalte_Erg), .Cells(Zeile_ErgE, Spalte_Erg))
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
Next Zeile_M
.Cells(Zeile_D, 4).Value = varWert_D 'Originalwert in Splate D wieder eintragen
Next Zeile_D
Application.CutCopyMode = False
End With
End Sub

Hallo Franz,
Vielen, vielen Dank, dass du dir die Zeit genommen hast sogar das ganze Makro zu schreiben!
Ich habe auch viel daran getüftelt und konnte ein Makro schreiben das fast machte was ich wollte.
So wie unten ist es in meiner Datei, nicht dem Muster.
Der entscheidende Tip der mich die letzten Stunden beschäftigt hat (unten r = r + 1) kam
von deinem "Spalte_Erg = Spalte_Erg + 1", daran wäre ich mit meinen "for each"-Versuchen wohl noch
ewig gescheitert. Jetzt läuft es super. Nicht schnell, aber das macht nichts.
Bin mir sicher, dass es mit deinem Makro hingehauen hätte, wenn du mir nich geholfen hättest es fertig zu tüfteln :)Schaut ziemlich ausgeklügelt aus!
Nochmal Danke,
Grüße,
Alex

Sub mein_makro()
End Sub

Dim i As Long
Dim j As Long
Dim r As Long
'habe drei verschiedene Blätter, nicht wie im Muster ein Blatt
Dim eu As Worksheet
Dim rp As Worksheet
Dim ta As Worksheet
Set eu = Worksheets("ein_blatt")
Set rp = Worksheets("ein_anderes_blatt")
Set ta = Worksheets("und_noch_eins")
r = 6
'r war die Ergebnisspalte
For j = 13 To 32
'j alle Positionen
For i = 7 To 26
'i alle Positionen ohne doppelte
ta.Range("D13:D32").Copy Destination:=ta.Range("A13:A32")
If rp.Range("B" & i).Value "" Then
rp.Range("B" & i).Copy Destination:=ta.Range("D" & j)
Application.Run _
"meine_datei.xlsm!DieseArbeitsmappe.Run_all_makros_below_in_this_order1"
eu.Range("S9:S389").Copy
rp.Cells(7, r).PasteSpecial Paste:=xlValues
'Warum weis ich nicht, aber .Copy Destination:= gab hier ganz andere (falsche) Ergebnisse
r = r + 1
End If
ta.Range("A13:A32").Copy Destination:=ta.Range("D13:D32")
Next i
Next j
Application.Run _
"meine_datei.xlsm!DieseArbeitsmappe.Run_all_makros_below_in_this_order1"
End Sub

Beliebteste Forumthreads (12 Monate)

2 (evtl. 3) Schleifen in einem Makro

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2 (evtl. 3) Schleifen in einem Makro

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread