Schleife für Aktivitäten wiederholung

[Anfänger2020]

Moin zusammen,

ich bitte um Eure Hilfe:
Aus einer Online Abfrage, Verein, habe ich die Daten per CSV in Excel importiert.

Die Daten je Person sind leider alle Senkrecht = 18 Angaben
Vorname Name etc.

Die erste Angabe der ersten Person, Vorname,  steht in A6 
Alle anderen Zeilen habe ich einzeln von A7 zu B6 usw. kopiert (Von Senkrecht in Waagrecht )
Erst Kopie Select Copy Paste,  dann die entstandene leere Zeile gelöscht.
Hier benötige ich nun eine Schleife die die nächste/n Person(en) mit je 17 weiteren Datenangaben jeweils in die nächste Zeile und Zellen schreibt
von A7 bis R7 (danach xlup)
bis zum Ende der Datei 

Danke im Voraus

[Klaus-Dieter]

Hallo,

mit diesem Makro habe ich so etwas mal für jeweils sieben Zeilen durchgeführt. Habe das jetzt für deinen Fall angepasst, der zu transponierende Bereich muss vorher selektiert werden. Das würde ich inzwischen alles etwas anders lösen, ist halt eine Jugendsünde.

Code:

Option Explicit

Sub transponieren()
' Klaus-Dieter Oppermann Mai 2005
' Variablen deklarieren
Dim arre As Variant                             ' Array Ausgangsdaten
Dim arra() As Variant                           ' Array transponierte Daten
Dim s As Integer                                ' Schleifenzähler
Dim ss As Integer                               ' Schleifenzähler Ausgangsdaten
Dim az As Integer                               ' Schleifenzähler 1. Arrayfeld transponierte Daten
Dim sp As Integer                               ' Schleifenzähler 2. Arrayfeld transponierte Daten
' Daten einlesen
arre = Selection                                ' markierten Bereich in Array
ReDim arra(UBound(arre) / 18, 18)                 ' Dimension an Liste anpassen
' transponieren
For s = LBound(arre) To UBound(arre) / 18        ' "äußere" Schleife
    For sp = 0 To 17                            ' "innere" Schleife (Arrayfelder)
        ss = ss + 1                             ' Zähler plus 1
        arra(az, sp) = arre(ss, 1)              ' Array mit transponierten Daten füllen
    Next sp                                     ' Schleifenzähler plus 1
    If ss Mod 18 = 0 Then az = az + 1            ' wenn "Zeile" im Array gefüllt, dann Feldzähler plus 1
Next s                                          ' Schleifenzähler plus 1
Range("C3", "T" & UBound(arre) / 18 + 3) = arra  ' transponierte Daten in Tabelle schreiben
' Liste formatieren
With Columns("C:T")                             ' Bereich definieren
    .WrapText = False                           ' kein Zeilenumbruch
    .EntireColumn.AutoFit                       ' optimale Spaltenbreite
End With                                        ' Ende der Definition
End Sub

[oee]

Hättest du mal Excel365, wäre alles mit einer einzigen Formel zu erledigen.

[oee]

Code:

Private Sub CommandButton1_Click()
    Dim rng, rng2(1 To 1000, 1 To 18), i, z, s
    rng = Range("A6:A1005").Value
    For i = 1 To 1000
        z = Int((i - 1) / 18) + 1
        s = ((i - 1) Mod 18) + 1
        rng2(z, s) = rng(i, 1)
    Next i
    Range("A6:R1005") = rng2
End Sub

[Anfänger2020]

Hallo,
danke werds gleich mal ausprobieren.

---

Danke Klaus-Dieter,

ich werd es ausprobieren.

[ws-53]

Das sollte mit Power Query auch sehr einfach gehen.

[snb]

PHP-Code:

Sub M_snb()
  For j = 1 To Cells(6, 1).CurrentRegion.Rows.Count Step 18
      Cells(j \ 18 + 1, 1).Resize(, 18) = Application.Transpose(Range("A6:A23").Offset(j-1))
  Next
End Sub 


[EA1950]

Hallo,

es gibt auch die Array-Funktion "=MTRANS(Matrix)", die man in Excel-Versionen vor Excel2021 als {=MTRANS(Matrix)} eingeben muss (d.h. mit Strg+UMSCHALT+EINGABE):
1) Zielbereich markieren
2) In die Formeleditierzeile die Formel =MTRANS(Quellbereich) eingeben
3) Die Formeleingabe in 2) nicht mit EINGABE-Taste abschließen, sondern mit der Tastenkombination Strg+UMSCHALT+EINGABE
4) Darauf hin erscheint die Formel im Zielbereich mit {=MTRANS(Quellbereich)}
5) Im Zielbereich: die Formel durch Kopieren-Werte in Werte umwandeln, sodass die Array-Formel verschwindet.