Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 10:13:05
Excel Tabelle - Ort/Stadt nur einmal pro Kunde zählen?
17.05.2024 09:40:47
Warum geht das Fenster aktualisieren auf
17.05.2024 09:18:12
Autofilter mit Copy Funktion bei mehr als 158 Zeilen
17.05.2024 08:39:33
Fehler bei: BlattBereich als .jpg in andere .xlsm kopieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1956to1960
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife und offset kombinieren

Schleife und offset kombinieren
25.12.2023 22:44:47
SvenjaMoe
Hallo. Ich bin leider noch Anfänger. Ich habe einen Code geschrieben, von der Daten von Liste 1 in Liste 2 kopiert werden. In Liste 1 soll jetzt eine Schleife damit er jedes Mal eine Zeile runtergeht. Er soll die Daten in Liste 2 aber immer mit 5 Zeilen Abstand eintragen. Kann mir jemand helfen?

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife und offset kombinieren
25.12.2023 23:58:14
Piet
Hallo

dann lade doch bitte mal deinen Code hoch, den du schon hast. Bitte mit allen Sheet, Range und Workbook Angaben.
Was genau soll von wo, aus welcher Spalte, in welche Spalte kopiert werden. Da gibt es mehrere Varianten zur Lösung.

mfg Piet
AW: Schleife und offset kombinieren
26.12.2023 19:23:01
Piet
Hallo

ich gehe davon aus das die neuen Daten immer in der Tabelle "Sondererhebung" unten angehangen werden sollen.
Dafür ist dieser Code, mit Offset von 5 Zeilen ausgelegt. - Bitte prüfen ob beim kopieren alle Spalten stimmen!!
Wir verzichten bei solchen Codes immer auf Sheet().Select + Range.Select. Der Code läuft so wesentlich schneller-.
Grüsse an die Polizei in NRW von einem Kölner aus Izmir.

mfg Piet 

Sub KopierenKS1_neu()

Dim j As Long, h, n, lz1 As Long

'SharePoint Objekt, z5 = Offset

Dim SPI As Worksheet, z5 As Long

Set SPI = Worksheets("Import SharePoint")



'Application.ScreenUpdating = False

With Sheets("Sondererhebung")

     'LastZell in Sondererhebung ermitteln

     h = .Cells(Rows.Count, 9).End(xlUp).Row   'I

     n = .Cells(Rows.Count, 14).End(xlUp).Row  'N

     If h >= n Then z5 = h - 3

     If n >= h Then z5 = n - 3

      

     'LastZell in SharPoint ermitteln

     lz1 = SPI.Cells(Rows.Count, 1).End(xlUp).Row

     For i = 1 To lz1  'Import kopieren

        SPI.Range("A1:G1").Offset(i, 0).Copy

        .Range("A5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

              

        SPI.Range("H1:J1").Offset(i, 0).Copy

        .Range("I5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("K1:M1").Offset(i, 0).Copy

        .Range("I6").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("N1:P1").Offset(i, 0).Copy

        .Range("I7").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

       

        SPI.Range("Q1:S1").Offset(i, 0).Copy

        .Range("I8").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("T1:V1").Offset(i, 0).Copy

        .Range("I9").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("W1").Offset(i, 0).Copy

        .Range("L5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("X1:AA1").Offset(i, 0).Copy

        .Range("N5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

        

        SPI.Range("AB1:AE1").Offset(i, 0).Copy

        .Range("N6").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("AF1:AI1").Offset(i, 0).Copy

        .Range("N7").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("AJ1:AM1").Offset(i, 0).Copy

        .Range("N8").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("AN1:AQ1").Offset(i, 0).Copy

        .Range("N9").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

      '    Durchnummerierung Einsatzkräfte'

       If .Range("I5").Offset(z5, 0) > "" Then .Range("H5").Offset(z5, 0) = 1

       If .Range("I6").Offset(z5, 0) > "" Then .Range("H6").Offset(z5, 0) = 2

       If .Range("I7").Offset(z5, 0) > "" Then .Range("H7").Offset(z5, 0) = 3

       If .Range("I8").Offset(z5, 0) > "" Then .Range("H8").Offset(z5, 0) = 4

       If .Range("I9").Offset(z5, 0) > "" Then .Range("H9").Offset(z5, 0) = 5

      '  Durchnummerierung TV

       If .Range("N5").Offset(z5, 0) > "" Then .Range("M5").Offset(z5, 0) = 1

       If .Range("N6").Offset(z5, 0) > "" Then .Range("M6").Offset(z5, 0) = 2

       If .Range("N7").Offset(z5, 0) > "" Then .Range("M7").Offset(z5, 0) = 3

       If .Range("N8").Offset(z5, 0) > "" Then .Range("M8").Offset(z5, 0) = 4

       If .Range("N9").Offset(z5, 0) > "" Then .Range("M9").Offset(z5, 0) = 5

       

       'Offset 5 Zeilen nach unten

       z5 = z5 + 5

     Next i

End With

End Sub
Anzeige
AW: Schleife und offset kombinieren
26.12.2023 19:24:41
Piet
Nachtrag

ich wünsche euch allen von ganzem Herzen ein gewaltfreies neues Jahr. Eine friedliche Einsatzzeit.

mfg Piet
AW: Schleife und offset kombinieren
26.12.2023 00:24:47
SvenjaMoe
Habt die Datei hochgeladen.
https://www.herber.de/bbs/user/165477.xlsm
Da ist der Code hinterlegt.
Das Problem ist, dass es genauso wie auf dem Tab Sondererhebung formatiert sein muss.
Es wird also vom Tab SharePoint Import in Sondererhebung kopiert.
Dafür brauche ich jetzt eine Schleife und er soll immer 5 Zeilen Abstand lassen.
Danke schon mal für deine Unterstützung!
AW: Schleife und offset kombinieren
26.12.2023 11:20:45
Alwin Weisangler
Hallo,
das sollte so reichen. 


Option Explicit

    Const iStart As Long = 5



Sub aufdroeseln()

    Dim i&, j&

    With Tabelle4

        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

            If InStr(1, .Cells(i, 4), "X", vbTextCompare) > 0 Then

                .Range("A" & i & ":AQ" & i).Copy

                Tabelle1.Cells(iStart + j, 1).PasteSpecial xlPasteValues

                j = j + 5

            End If

        Next i

    End With

End Sub

Ist lediglich, da jeder zutreffende Datensatz einzeln kopiert wird, etwas lahm bei großen Datenmengen.

Gruß Uwe
Anzeige
AW: Schleife und offset kombinieren
26.12.2023 11:51:22
Piet
Hallo

ich weiss nicht ob der Code des Kollegen so klappen wird. Mir filen Spalten Überschneidungen und Zeilenversatz auf!
Hier mal ein Lösungsversuch von mir, bei der der makroRecorder Code beibehalten wurde. Aber mit Offset z5 arbeitet.
Die Durchnummerierung habe ich in diesem Erstversuch übersprungen.

Bitte dringend dden Test NICHT in der Originaldatei durchzuführen.

mfg Piet 

Sub KopierenKS1_neu()

Dim j As Long, lz1 As Long

'SharePoint Objekt, z5 = Offset

Dim SPI As Worksheet, z5 As Long

Set SPI = Worksheets("Import SharePoint")



Application.ScreenUpdating = False

With Sheets("Sondererhebung")

     'LastZell in SharPoint ermitteln

     lz1 = SPI.Cells(Rows.Count, 1).End(xlUp).Row

     For i = 1 To lz1  'Import kopieren

        SPI.Range("A1:G1").Offset(i, 0).Copy

        .Range("A5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

      

        SPI.Range("H1:J1").Offset(i, 0).Copy

        .Range("I5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("K1:M1").Offset(i, 0).Copy

        .Range("I6").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("N1:P1").Offset(i, 0).Copy

        .Range("I7").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

       

        SPI.Range("Q1:S1").Offset(i, 0).Copy

        .Range("I8").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("T1:V1").Offset(i, 0).Copy

        .Range("I9").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("W1").Offset(i, 0).Copy

        .Range("L5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("X1:AA1").Offset(i, 0).Copy

        .Range("N5").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

        

        SPI.Range("AB1:AE1").Offset(i, 0).Copy

        .Range("N6").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("AF1:AI1").Offset(i, 0).Copy

        .Range("N7").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("AJ1:AM1").Offset(i, 0).Copy

        .Range("N8").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

        SPI.Range("AN1:AQ1").Offset(i, 0).Copy

        .Range("N9").Offset(z5, 0).PasteSpecial Paste:=xlPasteValues

    

       'Offset 5 Zeilen nach unten

       z5 = z5 + 5

GoTo weiter



'Für diesen Teil muss ich noch den Offset austüfteln!!



      '    Durchnummerierung Einsatzkräfte'

       If .Range("I5").Value > "" Then .Range("H5").Value = 1

       If .Range("I6").Value > "" Then .Range("H6").Value = 2

       If .Range("I7").Value > "" Then .Range("H7").Value = 3

       If .Range("I8").Value > "" Then .Range("H8").Value = 4

       If .Range("I9").Value > "" Then .Range("H9").Value = 5

      '  Durchnummerierung TV

       If .Range("N5").Value > "" Then .Range("M5").Value = 1

       If .Range("N6").Value > "" Then .Range("M6").Value = 2

       If .Range("N7").Value > "" Then .Range("M7").Value = 3

       If .Range("N8").Value > "" Then .Range("M8").Value = 4

       If .Range("N9").Value > "" Then .Range("M9").Value = 5

weiter:

    Next i

End With

End Sub
Anzeige
AW: Schleife und offset kombinieren
27.12.2023 07:03:15
SvenjaMoe
Ich danke euch allen sehr für die Hilfe!
@Piet: mir fehlt noch die Definition der Variable i in dem Code.
AW: Schleife und offset kombinieren
27.12.2023 07:16:27
SvenjaMoe
Hab selber hingekriegt. Immerhin. Code funktioniert bestens. Danke danke danke :)

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige