Office: (Office 2016) VBA zum Kopieren mehrerer Bereiche wenn Bedingung erfüllt

Helfe beim Thema VBA zum Kopieren mehrerer Bereiche wenn Bedingung erfüllt in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich bin gerade ziemlich am Verzweifeln. Habe 15 Dateien mit je ca. 500.000 Zeilen. Die Blätter sind folgendermaßen strukturiert: <tbody>... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Ines50000, 27. November 2019.

  1. Ines50000 Neuer User

    VBA zum Kopieren mehrerer Bereiche wenn Bedingung erfüllt


    Hallo,

    ich bin gerade ziemlich am Verzweifeln. Habe 15 Dateien mit je ca. 500.000 Zeilen. Die Blätter sind folgendermaßen strukturiert:

    [TABLE="class: grid, width: 500, align: left"]
    <tbody>[TR]
    [TD]Datum + Uhrzeit[/TD]
    [TD]Wert[/TD]
    [TD]Intervall-Nr[/TD]
    [/TR]
    [TR]
    [TD]1.1.19 12:30:05[/TD]
    [TD]3[/TD]
    [TD]1[/TD]
    [/TR]
    [TR]
    [TD]1.1.19 12:30:15[/TD]
    [TD]3,2[/TD]
    [TD]1[/TD]
    [/TR]
    [TR]
    [TD]1.1.19 12:30:25[/TD]
    [TD]2[/TD]
    [TD]1[/TD]
    [/TR]
    [TR]
    [TD]1.1.19 18:50:39[/TD]
    [TD]4[/TD]
    [TD]2[/TD]
    [/TR]
    [TR]
    [TD]2.1.19 00:03:49[/TD]
    [TD]3[/TD]
    [TD]2[/TD]
    [/TR]
    [TR]
    [TD][/TD]
    [TD]6[/TD]
    [TD]....[/TD]
    [/TR]
    [TR]
    [TD][/TD]
    [TD][/TD]
    [TD]...[/TD]
    [/TR]
    [TR]
    [TD][/TD]
    [TD][/TD]
    [TD]...[/TD]
    [/TR]
    [TR]
    [TD]19.8.19 23:33:12[/TD]
    [TD]7[/TD]
    [TD]99[/TD]
    [/TR]
    </tbody>[/TABLE]















    Die Intervalle lassen sich nicht nach Datum oder so sortieren.

    Ein Intervall besteht aus immer unterschiedlichen Zeilenanzahlen (ca. 10.000 Zeilen je Intervall). Jede Datei hat eine unterschiedliche Anzahl an Intervallen (meist zw. 30 und 100 Stück)

    Nun möchte ich gerne, dass mein Makro die Intervalle einzeln in Spalten nebeneinander aufführt:
    [TABLE="class: grid, width: 1000"]
    <tbody>[TR]
    [TD]Datum+Uhrzeit[/TD]
    [TD]Wert[/TD]
    [TD]Intervall[/TD]
    [TD][/TD]
    [TD]Datum + Uhrzeit[/TD]
    [TD]Wert[/TD]
    [TD]Intervall[/TD]
    [TD][/TD]
    [TD].....[/TD]
    [TD]Datum + Uhrzeit[/TD]
    [TD]Wert[/TD]
    [TD]Intervall[/TD]
    [/TR]
    [TR]
    [TD]1.1.19 12:30:05[/TD]
    [TD]3[/TD]
    [TD]1[/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD]2[/TD]
    [TD][/TD]
    [TD].....[/TD]
    [TD][/TD]
    [TD][/TD]
    [TD]99[/TD]
    [/TR]
    [TR]
    [TD]1.1.19 12:30:15[/TD]
    [TD]3,2[/TD]
    [TD]1[/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD]2[/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD]99[/TD]
    [/TR]
    [TR]
    [TD]....[/TD]
    [TD][/TD]
    [TD]1[/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD]2[/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD][/TD]
    [TD]99[/TD]
    [/TR]
    </tbody>[/TABLE]

    Habe schon diverse Makro Vorlagen probiert, allerdings ist es immer an irgendwas gescheitert. Das viel versprechensde hatte leider nur 5 Intervalle, die alle einzeln in den Variablen aufgeführt waren. Dort hätte ich das immer händisch an meine Intervallzahl anpassen müssen.

    Vielen Dank schon mal
     
    Zuletzt von einem Moderator bearbeitet: 30. November 2020
    Ines50000, 27. November 2019
    #1
  2. Exl121150 Erfahrener User
    Hallo,

    nachfolgendes VBA-Makro müsste dein Problem lösen:
    Code:
    Option Explicit
    
    Public Sub Transponieren_von3_nach297spaltig()
      Dim BlattQuelle$, WsQ As Worksheet
      Dim BlattZiel$, WsZ As Worksheet
      Dim Zeile As Range
      Dim IntQ As Long, IntZ As Long, ZlZ As Long, SpZ As Long
      
      BlattQuelle$ = "[COLOR="#FF0000"]Tabelle1[/COLOR]"  'Blatt besitzt  3 Spalten (Datum+Uhrzeit, Wert, Intervall-Nr)
      BlattZiel$ = "[COLOR="#FF0000"]Tabelle2[/COLOR]"    'Blatt benötigt 3*99=297 Spalten
      
      Set WsQ = Worksheets(BlattQuelle$)
      Set WsZ = Worksheets(BlattZiel$)
      
      'Im BlattZiel: Alle Zellen löschen
      WsZ.Cells.Clear
      
      For Each Zeile In WsQ.UsedRange.Rows
        If Zeile.Row = 1 Then
          'Kopfzeile
          For IntZ = 1 To 99 * 3 - 2 Step 3
            For SpZ = 0 To 2
              WsZ.Cells(1, IntZ + SpZ).Value = Zeile.Cells(SpZ + 1).Value
            Next SpZ
          Next IntZ
        Else
          'Datenzeile
          IntQ = Zeile.Cells(3).Value  'Intervall-Nr
          IntZ = IntQ * 3 - 2          'Spalten-Nr1 im Zielblatt für Intervall-Nr
          'Ermittle erste freie Zeile im Intervall-Nr-Block
          ZlZ = WsZ.Cells(Rows.Count, IntZ).End(xlUp).Row + 1
          'Übertrage die 3 Zellen der Zeile
          For SpZ = 0 To 2
            WsZ.Cells(ZlZ, IntZ + SpZ).Value = Zeile.Cells(SpZ + 1).Value
          Next SpZ
        End If
      Next Zeile
      
      'Im BlattZiel: Intervall-Blöcke rechts durch doppelblaue Linien begrenzen
      For IntZ = 3 To 99 * 3 Step 3
        With WsZ.Columns(IntZ).EntireColumn.Borders(xlEdgeRight)
          .LineStyle = xlDouble
          .Color = vbBlue
          .TintAndShade = 0
          .Weight = xlThick
        End With
      Next IntZ
      
      'Im BlattZiel: Spalten auf optimale Breite einstellen
      WsZ.Cells.EntireColumn.AutoFit
    
    End Sub
    
    Dieses Makro in ein allgemeines Codemodul kopieren und eventuell die rot gekennzeichneten Arbeitsblattnamen an deine Arbeitsblattnamen anpassen.
    Dann kann es über die Tastenkombination Alt+F8 und Button "Ausführen" ausgeführt werden.
     
    Exl121150, 27. November 2019
    #2
Thema:

VBA zum Kopieren mehrerer Bereiche wenn Bedingung erfüllt

Die Seite wird geladen...
  1. VBA zum Kopieren mehrerer Bereiche wenn Bedingung erfüllt - Similar Threads - VBA Kopieren mehrerer

  2. VBA Zeilen kopieren mit Bedingung

    in Microsoft Excel Hilfe
    VBA Zeilen kopieren mit Bedingung: Hallo zusammen, Ich möchte per Makro Zeilen aus Tabelle2 in Tabelle3 kopieren, wenn eine Bedingung erfüllt ist. Bedingung: Der Wert in Spalte E (Tabelle2) kommt in Tabelle1 in Spalte E vor....
  3. VBA - Datensätze ans Ende einer anderen Tabelle kopieren

    in Microsoft Excel Hilfe
    VBA - Datensätze ans Ende einer anderen Tabelle kopieren: Hallo zusammen, ich habe gerade eine "Abrechnungs"-Datei für einen Kindergartenbasar erstellt. Es wäre klasse, wenn man per Schaltfläche die Datensätze aus der Tabelle "Kaeufer" ans Ende der...
  4. VBA mehrere Spalten abfragen, kopieren einfügen

    in Microsoft Excel Hilfe
    VBA mehrere Spalten abfragen, kopieren einfügen: Hi zusammen, mit folgendem code frage ich mehrere sheets ab und eine Spalte (C) und wenn in der Spalte ein X steht kopiert er mir die ganze Zeile und fügt sie mir auf Tabelle1 ein. Jetzt möchte...
  5. Wie kann ich mit VBA mehrere Zellen kopieren?

    in Microsoft Excel Hilfe
    Wie kann ich mit VBA mehrere Zellen kopieren?: Ich möchte in Excel 2003 mit einem Makro folgendes erreichen: In einem Arbeitsplan steht ein Beispiel in den Zellen von A4 - BA7 Darin enthalten sind verbundene, farbig hinterlegte und...
  6. Makro VBA: Kopieren aus Quelldatei nach Zieldatei über mehrere Tabellen

    in Microsoft Excel Hilfe
    Makro VBA: Kopieren aus Quelldatei nach Zieldatei über mehrere Tabellen: Hallo, leider kann ich maximal Makros aufzeichnen. Damit komme ich bei meinem jetzigen Problem allerdings nicht weiter. Problem: Monatlich soll ein Auszug von Daten aus einer Quelldatei die ich...
  7. Grafik auf mehrere Arbeitsblätter kopieren

    in Microsoft Excel Hilfe
    Grafik auf mehrere Arbeitsblätter kopieren: Hallo zusammen, ich habe eine Excel Datei mit 9 Arbeitsblättern. Ich möchte auf dem ersten Arbeitsblatt ein Bild in Zelle J1 einfügen. Dieses Bild soll dann auf den Arbeitsblättern 2-7...
  8. Excel 2003 Kopieren mehrerer Zellen mit VBA

    in Microsoft Excel Hilfe
    Excel 2003 Kopieren mehrerer Zellen mit VBA: Hallo, ich bin ganz frisch in VBA deshalb bitte ich um Nachsicht. :-) Folgendes: Erstens: Ich kopiere eine Zelle in einem Tabellenblatt und füge sie auf einem anderen Blatt ein. Dann die...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden