Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 13:08:24

thepinky

Hallo zusammen,

ich möchte Werte aus einer senkrechten Spalte in eine waagrechte kopieren.
Jetzt zu meinem Problem.

5 Werte gehören immer zusammen.

Sind es lediglich 5 Werte, werden diese einfach von senkrecht nach waagrecht übernommen.
Bei 10 Werten gehört jeweils jeder zweite Wert zu dem vorherigen und bei 15 Werten jeder 3 Wert usw.

Ich könnte das jetzt wie in meiner angehangenen Beispieldatei weiter fortführen bis ich 16 Nester = 80 Werte durchgearbeitet habe.
Das ganze ist dann erstmal reine Fleißarbeit und der Code sieht überhaupt nicht schön aus.

Gibt es dazu eine smartere Lösung?
Vielen dank für eure Mühe.

Beisüieldatei:
https://www.herber.de/bbs/user/176378.xlsm

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 13:31:21

RPP63

Moin!
Sehr aussagekräftige Beispieldatei (Reihe 1 bis 5)!
Schaue Dir folgendes an (ganz ohne VBA):

=ZEILENUMBRUCH(C2:C81;5;"")

Gruß Ralf

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 16:48:20

thepinky

@Ralf

hast du dir den VBA Code überhaupt einmal angeschaut um den es geht?

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 13:44:38

Oberschlumpf

Hi,

auch, wenn du gleich vllt denkst, ich bin "kleinkariert", möchte ich dich trotzdem bitten, dir recht schnell die richtigen Bezeichnungen anzugewöhnen:

- Spalten werden immer senkrecht angeordnet = da musst du dies nicht extra "senkrechte Spalten" nennen, bezeichne es einfach als Spalten
- waagerechte Spalten...grmpfl...gibt es nicht! = DAS sind dann die ZEILEN

Ciao
Thorsten

Im Anhang habe...

23.03.2025 17:19:12

Case

Moin, :-)

... ich dir ein Beispiel erstellt (Formel, VBA und Power Query): ;-)
https://www.herber.de/bbs/user/176379.xlsb

Das sind alles nur Ansätze - bezogen auf deine 5er Blöcke. Da maximal 80 Werte, kann man gut mit Schleifen arbeiten, sonst per Array. ;-)

Bei Power Query musst du - nach Änderung der Datenlage - Aktualisieren. ;-)

Servus
Case

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 18:16:43

Kuwer

Hallo,

hier noch meine VBA-Version:

Sub FuenferTransponieren()

  Const WerteProNest As Long = 5

  Dim AnzahlNester As Long

  Dim i As Long, j As Long, k As Long

  Dim varQ As Variant, varZ As Variant

  

  varQ = Range("C2:C" & Application.Max(2, Cells(Rows.Count, 3).End(xlUp).Row)).Value

  If IsEmpty(varQ) Then

    MsgBox "Es sind keine Werte vorhanden!"

  Else

    If UBound(varQ) Mod WerteProNest Then

      MsgBox "Die Anzahl der Messwerte ist nicht korrekt!"

    Else

      ReDim varZ(1 To UBound(varQ) / WerteProNest, 1 To WerteProNest)

      AnzahlNester = UBound(varZ)

      MsgBox "Die PPA enthält " & AnzahlNester & " Nest" & IIf(AnzahlNester = 1, ".", "er.")

      For i = 1 To UBound(varQ)

        If ((i - 1) Mod AnzahlNester) = 0 Then

          j = 1

          k = k + 1

        Else

          j = j + 1

        End If

        varZ(j, k) = varQ(i, 1)

      Next i

      Range("I2").Resize(AnzahlNester, WerteProNest).Value = varZ

    End If

  End If

End Sub

Gruß, Uwe

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 18:34:41

thepinky

Wenn ich das ganze über Power Query umsetze, gibt es ja über den Abfrageeditor eine einfache Möglichkeit die Quelldatei zu ändern.
Das ganze funktioniert mit kleinen Anpassungen auch soweit, aber gibt es auch eine Möglichkeit die Quelldatei für den Anwender auswählen zu können, ohne in den Abfrageeditor gehen zu müssen?

Wenn du den...

23.03.2025 19:26:50

Case

Moin, :-)

... Dateinamen in Power Query variabel halten möchtest, dann geht das z. B. über eine Zelle: ;-)
https://www.tabellenexperte.de/eine-einzelne-zelle-an-power-query-uebergeben/

Weitere Infos auch hier: ;-)
https://excelhero.de/power-query/power-query-ganz-einfach-erklaert/

Servus
Case

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 19:47:30

thepinky

@Uwe

der VBA Code ist ja auch sehr gut, ich bin begeistert was und wie es funktionieren kann!
Wie könnte man das ganze noch sauber umsetzen, sodass dein Code in der "Zieldatei" ausgeführt wird und vorher die Quelldatei angewählt werden kann.
Sinngemäß sowie dieser Anfang......

'Datendatei öffnen
MsgBox ("Quelldatei öffnen")
Datei = Application.Dialogs(xlDialogOpen).Show
If Datei = False Then Exit Sub
Application.ScreenUpdating = False
Set wbQuelle = ActiveWorkbook

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 21:16:36

Kuwer

Hallo,

so z.B.:

Sub PPA_Exportieren()

  Const WerteProNest As Long = 5

  Dim AnzahlNester As Long

  Dim i As Long, j As Long, k As Long

  Dim varQ As Variant, varZ As Variant

  

  varQ = Range("C2:C" & Application.Max(2, Cells(Rows.Count, 3).End(xlUp).Row)).Value

  If IsEmpty(varQ) Then

    MsgBox "Es sind keine Werte vorhanden!"

  Else

    If UBound(varQ) Mod WerteProNest Then

      MsgBox "Die Anzahl der Messwerte ist nicht korrekt!"

    Else

      ReDim varZ(1 To UBound(varQ) / WerteProNest, 1 To WerteProNest)

      AnzahlNester = UBound(varZ)

      MsgBox "Die PPA enthält " & AnzahlNester & " Nest" & IIf(AnzahlNester = 1, ".", "er.")

      For i = 1 To UBound(varQ)

        If ((i - 1) Mod AnzahlNester) = 0 Then

          j = 1

          k = k + 1

        Else

          j = j + 1

        End If

        varZ(j, k) = varQ(i, 1)

      Next i

      If Application.Dialogs(xlDialogOpen).Show Then

        Range("I2").Resize(AnzahlNester, WerteProNest).Value = varZ

      Else

        MsgBox "Es wurde keine Zieldatei ausgewählt!", vbCritical

      End If

    End If

  End If

End Sub

Gruß, Uwe

AW: Werte aus senkrechter Spalte schematisch kopieren

23.03.2025 21:38:01

Kuwer

Für Import dann so z.B:

Sub PPA_Importieren()

  Const WerteProNest As Long = 5

  Dim AnzahlNester As Long

  Dim i As Long, j As Long, k As Long

  Dim rngStartzelle As Range

  Dim varQ As Variant, varZ As Variant

  

  Set rngStartzelle = ActiveSheet.Range("I2")

  

  Application.ScreenUpdating = False

  If Application.Dialogs(xlDialogOpen).Show Then

    varQ = Range("C2:C" & Application.Max(2, Cells(Rows.Count, 3).End(xlUp).Row)).Value

    If IsEmpty(varQ) Then

      MsgBox "Es sind keine Werte vorhanden!"

    Else

      If UBound(varQ) Mod WerteProNest Then

        MsgBox "Die Anzahl der Messwerte ist nicht korrekt!"

      Else

        ReDim varZ(1 To UBound(varQ) / WerteProNest, 1 To WerteProNest)

        AnzahlNester = UBound(varZ)

        MsgBox "Die PPA enthält " & AnzahlNester & " Nest" & IIf(AnzahlNester = 1, ".", "er.")

        For i = 1 To UBound(varQ)

          If ((i - 1) Mod AnzahlNester) = 0 Then

            j = 1

            k = k + 1

          Else

            j = j + 1

          End If

          varZ(j, k) = varQ(i, 1)

        Next i

        rngStartzelle.Resize(AnzahlNester, WerteProNest).Value = varZ

      End If

    End If

    ActiveWorkbook.Close False

  Else

    MsgBox "Es wurde keine Quelldatei ausgewählt!", vbCritical

  End If

  Application.ScreenUpdating = True

End Sub

Gruß, Uwe

AW: Werte aus senkrechter Spalte schematisch kopieren

24.03.2025 12:27:17

thepinky

Vielen Dank!
Versuche das ganze jetzt aus einer CSV-Datei zu lesen...... und habe den Code folgendermaßen angepasst.
Dies funktioniert leider nicht, weil es mir den Aufbau zerschießt.

Wenn ich die CSV vorher händisch als XLSX abspeichere, funktioniert es.





Sub PPA_Importieren_2()

  Const WerteProNest As Long = 5

  Dim AnzahlNester As Long

  Dim i As Long, j As Long, k As Long

  Dim rngStartzelle As Range

  Dim varQ As Variant, varZ As Variant

  Dim csvFile As String

  Dim xlsxFile As String

  Dim wb As Workbook

  

  Set rngStartzelle = ActiveSheet.Range("I2")

  

  Application.ScreenUpdating = False

  If Application.Dialogs(xlDialogOpen).Show Then

    csvFile = ActiveWorkbook.FullName

    xlsxFile = Replace(csvFile, ".csv", ".xlsx")

    

    ' CSV-Datei öffnen und als XLSX speichern

    Set wb = Workbooks.Open(csvFile)

    wb.SaveAs Filename:=xlsxFile, FileFormat:=xlOpenXMLWorkbook

    wb.Close SaveChanges:=True

    

    ' XLSX-Datei erneut öffnen

    Set wb = Workbooks.Open(xlsxFile)

    

    ' Daten aus der XLSX-Datei lesen

    varQ = wb.Sheets(1).Range("H5:H" & Application.Max(2, wb.Sheets(1).Cells(Rows.Count, 8).End(xlUp).Row)).Value

    If IsEmpty(varQ) Then

      MsgBox "Es sind keine Werte vorhanden!"

    Else

      If UBound(varQ) Mod WerteProNest Then

        MsgBox "Die Anzahl der Messwerte ist nicht korrekt!"

      Else

        ReDim varZ(1 To UBound(varQ) / WerteProNest, 1 To WerteProNest)

        AnzahlNester = UBound(varZ)

        MsgBox "Die PPA enthält " & AnzahlNester & " Nest" & IIf(AnzahlNester = 1, ".", "er.")

        For i = 1 To UBound(varQ)

          If ((i - 1) Mod AnzahlNester) = 0 Then

            j = 1

            k = k + 1

          Else

            j = j + 1

          End If

          varZ(j, k) = varQ(i, 1)

        Next i

        rngStartzelle.Resize(AnzahlNester, WerteProNest).Value = varZ

      End If

    End If

    

    wb.Close SaveChanges:=True

  Else

    MsgBox "Es wurde keine Quelldatei ausgewählt!", vbCritical

  End If

  Application.ScreenUpdating = True

End Sub

Also...

24.03.2025 15:38:51

Case

Moin, :-)

... Power Query kann sehr gut mit CSV Dateien umgehen. Was spricht dagegen? ;-)

Servus
Case

AW: Im Anhang habe...

23.03.2025 17:46:03

thepinky

@Case

wow, das hilft mir weiter!
Vielen Dank!

Werte aus senkrechter Spalte schematisch kopieren

Forumthread: Werte aus senkrechter Spalte schematisch kopieren

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Werte aus senkrechter Spalte schematisch kopieren

Forumthread: Werte aus senkrechter Spalte schematisch kopieren

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread