Schleife, zu kopierenden Bereich anpassen

Forumthread: Schleife, zu kopierenden Bereich anpassen

19.07.2024 16:36:11

Fred

Hallo Excel Profis,
u.a. übertrage ich Daten von "Paarung" nach "Plan"
Eigentlich möchte ich "nur" den Bereich "Paarung", AX1:CR1 nach "Plan" in entsprechende Zeilen kopieren.
Doch es werden auch Daten kopiert, die in mehrere Spalten nach CR vorhanden sind.

Sub berechnungen1()

    Dim zeile As Long

    Dim i As Long

Application.ScreenUpdating = False

    For zeile = 11 To Sheets("Plan").Cells(Rows.Count, 1).End(xlUp).Row

        If Sheets("Plan").Cells(zeile, 11) > 1 Then

            

            Application.ScreenUpdating = False

            

            Sheets("Liga").Cells(2, 11) = Sheets("Plan").Cells(zeile, 2)

            Sheets("Liga").Cells(3, 11) = Sheets("Plan").Cells(zeile, 3)



            Call Verteiler_1



            For i = 1 To 79

                Sheets("Plan").Cells(zeile, 5 + i - 1) = Sheets("Paarung").Cells(1, 49 + i)

            Next i

        End If

    Next zeile



Application.ScreenUpdating = True



End Sub

Wie passe ich das Makro entsprechend an?

Gruss
Fred

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Schleife, zu kopierenden Bereich anpassen

19.07.2024 17:05:15

GerdL

Hallo Fred,

anstatt die Schleife nur bis i = 1 to 46 laufen zu lassen, kannst du ohne diese Schleife

Sheets("Plan").Cells(zeile, 5).Resize(1, 46).Value = Sheets("Paarung").Cells(1, 50).Resize(1, 46).Value

schreiben.

Gruß Gerd

AW: Schleife, zu kopierenden Bereich anpassen

19.07.2024 17:27:15

Fred

Bestens, Gerd !!

Sheets("Plan").Cells(zeile, 5).Resize(1, 47).Value = Sheets("Paarung").Cells(1, 50).Resize(1, 47).Value

Passt!
Ich habe das nun mal so übernommen.
zB mit diesen "Resize" habe ich irgendwie meine Probleme,- fehlt wohl ne Synapse.
Kannst du vieleicht noch erklären, warum die Schleife nicht wie gewünscht abarbeitete?

Wie auch immer,- VIELEN Dank!

Gruss
Fred

AW: Schleife, zu kopierenden Bereich anpassen

19.07.2024 19:52:18

Yal

Hallo Fred,

wahrscheinlich, weil Cells( .., ..) eine Objekt darstellt und die Allokation Objekt zu Objekt nicht präzis genug ist.
Setze den Eigenschaft .Value dazu, dann ist es eine Übertragung von Eigenschaft zu Eigenschaft.

Sub berechnungen1()

Dim zeile As Long

Dim i As Long

    

    Application.ScreenUpdating = False

    With Sheets("Plan")

        For zeile = 11 To .Cells(.Rows.Count, 1).End(xlUp).Row

            If .Cells(zeile, 11).Value > 1 Then

                Sheets("Liga").Cells(2, 11).Value = .Cells(zeile, 2).Value

                Sheets("Liga").Cells(3, 11).Value = .Cells(zeile, 3).Value

                Call Verteiler_1

                For i = 0 To 78

                    .Cells(zeile, 5 + i).Value = Sheets("Paarung").Cells(1, 50 + i).Value

                Next i

            End If

        Next zeile

    End With

    Application.ScreenUpdating = True

End Sub

(die Version mit Resize ist trotzdem besser!)

Ist es Dir bewusst, dass die Werte in Zellen
Sheets("Liga").Cells(2, 11) und Sheets("Liga").Cells(3, 11)
immer wieder neu überschrieben werden, bis die letzte Werte reinkommt? Es mag einen Grund haben, sieht aber komisch aus.

VG
Yal

AW: Schleife, zu kopierenden Bereich anpassen

19.07.2024 22:23:29

Fred

Hallo Yal,
jo, du hast recht und mir ist es gar nicht aufgefallen, dass die Werte in den Zellen in jeder Iteration der Schleife überschrieben werden.
Hm, einen richtig guten (optimalen) Code hatte ich ohnehin noch nie geschrieben ... :-)

Sub berechnungen1()

    Dim zeile As Long

    Dim i As Long

    

    Application.ScreenUpdating = False

    With Sheets("Plan")

        For zeile = 11 To .Cells(.Rows.Count, 1).End(xlUp).Row

            If .Cells(zeile, 11).Value > 1 Then

                If Sheets("Liga").Cells(2, 11).Value > .Cells(zeile, 2).Value Then

                    Sheets("Liga").Cells(2, 11).Value = .Cells(zeile, 2).Value

                End If

                If Sheets("Liga").Cells(3, 11).Value > .Cells(zeile, 3).Value Then

                    Sheets("Liga").Cells(3, 11).Value = .Cells(zeile, 3).Value

                End If

                Call Verteiler_1

                For i = 0 To 78

                    .Cells(zeile, 5 + i).Value = Sheets("Paarung").Cells(1, 50 + i).Value

                Next i

            End If

        Next zeile

    End With

    Application.ScreenUpdating = True

End Sub

Diese Anpassung sorgt dafür, dass die Werte in Sheets("Liga").Cells(2,11) und Sheets("Liga").Cells(3,11) nur dann gesetzt werden, wenn sie von den aktuellen Werten in Sheets("Plan") abweichen. Dies sollte unnötige Schreibvorgänge minimieren und könnte wohl auch die Leistung verbessern.
Nun aber:

Sheets("Plan").Cells(zeile, 5).Resize(1, 47).Value = Sheets("Paarung").Cells(1, 50).Resize(1, 47).Value

Vielen Dank für deine Aufmerksamkeit Yal !!

Gruss
Fred

Beliebteste Forumthreads (12 Monate)

Schleife, zu kopierenden Bereich anpassen

Forumthread: Schleife, zu kopierenden Bereich anpassen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread