Zelleninhalte mit bestimmtem Abstand transponieren mit Schleife

Guten Mittag alle miteinander,

und nun direkt zu meiner Frage. Ich möchte auch noch daraufhin weisen, dass ich leider nicht sehr viel Ahnung von der Materie habe und sehr dankbar für jegliche Hilfe wäre.
Ich habe folgendes in meinem Makro:

 
    Range("B11:B40").Select  
    Selection.Copy
    Range("D6").Select  
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    Range("B51:B80").Select  
    Selection.Copy
    Range("D46").Select  
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
    Range("B91:B120").Select  
    Selection.Copy
    Range("D86").Select  
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

funktioniert alles wie es soll.
Eleganter wäre es jedoch mit einer Schleife (hab mir im Netz schon diverse Seiten dazu angesehen bin aber leider nicht ganz durchgestiegen). Desweiteren soll diese Schleife so lange laufen bis kein Inhalt mehr alle 40 Zeilen kommt.

Hintergrund: Es werden immer alle Textdateien aus einem Ordner importiert. Die Anzahl dieser Textdateien kann aber variieren und ist nicht festgelegt. Das Aussehen/Layout dieser Dateien ist immer das selbe.

Vielen Dank

MfG

Jonas

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 283501

Url: https://administrator.de/contentid/283501

Ausgedruckt am: 03.12.2024 um 19:12 Uhr

4 Kommentare

Neuester Kommentar

Guten Morgen,

Hat denn keiner eine Idee?...

MfG
Jonas

Zitat von @KrenzJ:
Guten Morgen,

Guten Morgen Jonas,

Hat denn keiner eine Idee?...

na na nicht so ungeduldig, sind halt nicht immer alle Spezis in jeder Minute parat

...

Sub Transpose()
    Application.ScreenUpdating = False
    With ActiveSheet
        For i = 11 To .Cells(Rows.Count, "B").End(xlUp).Row - 29 Step 40  
            .Range("B" & i & ":B" & i + 29).Copy  
            .Range("D" & i - 5).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True  
        Next
    End With
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

Grüße Uwe

Hi Uwe,

Vielen Dank für deine Antwort. Bin leider ein sehr ungeduldiger Mensch und habe es auf eigene Faust probiert und sogar funktionsfähig gebracht. Ein paar weitere Arbeitsschritte eingebracht.

Ist meine Möglichkeit denn auch elegant? :D

Oder würdest du sagen das ist schlichtweg rotz?

Sub Transponieren()

    Sheets("Sheet1").Select  
    Range("B11").Select  
        ' Set Do loop to stop when two consecutive empty cells are reached.  
        Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
        'variables for actual cell at beginning of loop  
            Dim transRow As Long
            Dim transCol As Integer
            transRow = ActiveCell.Row
            transCol = ActiveCell.Column
            
            'mark all measurements (in this case 30 rows), copy, transpose, paste  
            Range(Cells(transRow, transCol), Cells(transRow + 29, transCol)).Select
            Selection.copy
            ActiveCell.Offset(-5, 2).Activate
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            'go back to active cell at beginning  
            Cells(transRow, transCol).Select
            ' Step down 40 rows from present location to next textimport  
            ActiveCell.Offset(40, 0).Select
        Loop
End Sub

MfG

Jonas

Zitat von @KrenzJ:
Ist meine Möglichkeit denn auch elegant? :D

Man kann immer auf mehreren Wegen sein Ziel erreichen, wenn man den Inhalt deiner Zellen genau kennt. Eine While Schleife ist natürlich eine andere Möglichkeit dies zu realisieren. Da ich aber den Inhalt deines Sheets nicht kannte war das ermitteln der letzten belegten Zelle von unten her in Spalte B das bevorzugte Mittel der Wahl, den. Es hätte ja sein können das es mehrere unbelegte Zellen dazwischen hätte geben können.

Oder würdest du sagen das ist schlichtweg rotz?

Die ganzen manuellen Selects machen so ein Skript extrem langsam, aber da du ein Anfänger bist weist du es eben noch nicht besser

Man arbeitet hier besser immer mit Range-Objekten und Zuweisen von Zellen anstatt immer wieder die Selection zu verschieben, das ist sehr sehr ineffizient, gerade bei Operationen die zehntausende Zellen verarbeiten müssen.

Das was der Makrorekorder aufzeichnet ist nicht das Optimum und spiegelt nur das wieder was der User mit seiner Maus macht. Effizienter Code sieht aber meist ganz anders aus.

Dafür das du noch wenig Ahnung von VBA mit Excel hast ist das doch in Ordnung, auch wenn es so wie's ausschaut irgendwo abgekupfert wurde ;-/. Für mich ist das ganze natürlich ziemlich umständlich gelöst, aber wie gesagt, jeder hat mal klein angefangen. Mit der Zeit entdeckt man immer bessere Methoden in Excel, da das Objektmodell sehr viele verschiedene Möglichkeiten bietet auf Zellen auch in Relation zueinander zu verweisen.

Also, ab und zu statt Google mal die VBA-Doku von Excel lesen, denn es ist meist sowieso besser eine Sprache von Grund auf zu erlernen.

Viel Erfolg weiterhin, und nicht zu ungeduldig sein, das produziert beim Programmieren meist nur Fehler die einem auf den ersten Blick nicht auffallen, dann aber später zu Tage treten weil man sie einfach nicht bedacht hat.

Grüße Uwe

p.s. wenns das dann war, bitte noch als Gelöst markieren.

gelöst Frage Microsoft Microsoft Office

Heiß diskutiert