Thema: Schleife bauen

Hallo zusammen,

bräuchte mal Hilfe wie ich mit VBA, denke mit einer Schleife, eine Spalte in 2 oder 3 Spalten umwandeln kann.

In der Grundspalte stehen Werte, die sollen nun von links nach rechts in 3 Spalten geschrieben werden.

Also vorher:
1
2
3
4
5
6

Nachher:

1 2 3
4 5 6

Die Grunddaten in der ersten Spalte kann zwischen 1 und mehreren Hundert Werten enthalten.
Leider sind die Schleifen für mich immer noch ein Buch mit 7 Siegeln.

Wäre super wenn jemand hier einen Ansatz für mich hat.

Gruß Chris

Hi
im Prinzip so:
i ist Schleifenzähler für lineare werte (1 bis x)
z ist der Zeilenzähler des zweidimensionalen Arrays
s ist der Spaltenzähler des zweidimensionalen Arrays

die Arrays beginnen mit 1

for i = 1 to x

   z = Int((i - 1) / AnzahlSpalten) + 1

   s = (i - 1) mod AnzahlSpalten + 1



  zweidimArray(z, s) = eindimArray(i)

next

Gruß Daniel

Wie Daniel schon beschreiben hat, geht es hier eigentlich um ein mathematisches Problem und hat weniger etwas mit Schleifen zu tun.

Du möchtest aus einem Index eine Zeile und eine Spalte berechnen. Direkt auf einen Bereich in Excel angewandt:

Option Explicit



Public Sub Test()

  

  Dim rngCell As Excel.Range

  Dim lngTargetRow As Long

  Dim lngTargetCol As Long

  

  With Worksheets("Tabelle1")

    With .Range("A1:A6") '<< anpassen, z.B. "D4:D9"

      

      For Each rngCell In .Cells

        lngTargetRow = .Row + (rngCell.Row - .Row) Mod 3

        lngTargetCol = .Row + (rngCell.Row - .Row) \ 3

        

        Debug.Print rngCell.Address(False, False);

        Debug.Print " = [" & rngCell.Row & ","; rngCell.Column & "]";

        Debug.Print " := " & rngCell.Value; " -> ";

        Debug.Print "[" & lngTargetRow & ","; lngTargetCol & "]"

        

        Call rngCell.Cut(Destination:=.Worksheet.Cells(lngTargetRow, lngTargetCol))

        

      Next

    End With

  End With

  

End Sub

Grüße

Vielen Dank schon bis hierher.

Zum einen werden die jetzt erst untereinander gesetzt und dann in die 2. Spalte. Eigentlich sollten es 3 Spalten werden bei den die ersten 3 Werte von links nach recht in die Spalten geschrieben werden und in Zeile 2 geht es dann weiter mit z.B. 4, 5 und 6
Also statt
1 4
2 5
3 6
so:
1 2 3
4 5 6
7 8 9 usw.
und kann ich das "With .Range("A1:A6")" auch auf alle Zellen in der Spalte die Inhalt haben setzen? Können nur 6 oder 8 sein, aber eben auch 150.
Und das Ziel müsste dann noch ein anderes Tabellenblatt sein.

Dank Danke Danke

» Zum einen werden die jetzt erst untereinander gesetzt und dann in die 2. Spalte. Eigentlich sollten es 3 Spalten werden bei den die ersten 3 Werte von links nach recht in die Spalten geschrieben werden

Einfach die Variablen miteinander tauschen - beschäftige dich bitte mit der Berechnung und warum das so funktioniert.

» und kann ich das "With .Range("A1:A6")" auch auf alle Zellen in der Spalte die Inhalt haben setzen? Können nur 6 oder 8 sein, aber eben auch 150.

Da solltest du dich mal hier im Forum umsehen. Diese Frage kommt gefühlt jeden Tag aufs Neue. (in Kürze: Range.End(xlUp) ansehen; hab es im Code angepasst)

» Und das Ziel müsste dann noch ein anderes Tabellenblatt sein.

Hier gibt es grundsätzliche verschiedene Wege das zu erreichen; Ausschneiden/Kopieren mit oder ohne Formatierung, das ist alles auf unterscheidliche Weise umsetzbar.
Wenn du einfach nur den Wert übertragen willst, dann z.B. so

Worksheets("AndereTabelle").Cells(lngTargetRow, lngTargetCol).Value = rngCell.Value

Hier der angepasste Code:

Option Explicit



Public Sub Test()

  

  Dim rngCell As Excel.Range

  Dim lngTargetRowOffset As Long

  Dim lngTargetColOffset As Long

  Dim lngColumns As Long

    

  lngColumns = 3

  

  With Worksheets("Tabelle1")

    With .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))

      

      For Each rngCell In .Cells

        lngTargetColOffset = (rngCell.Row - .Row) Mod lngColumns

        lngTargetRowOffset = (rngCell.Row - .Row) \ lngColumns

        

        Debug.Print rngCell.Address(False, False);

        Debug.Print " = [" & rngCell.Row & ","; rngCell.Column & "]";

        Debug.Print " := " & rngCell.Value; " -> ";

        Debug.Print "[R+" & lngTargetRowOffset & ", C+"; lngTargetColOffset & "]"

        

        Worksheets("AndereTabelle") _

          .Range("B2") _

          .Offset(lngTargetRowOffset, lngTargetColOffset) _

          .Value = rngCell.Value

        

      Next

    End With

  End With

  

End Sub

Hinweise:
* Während des Kopiervorgangs sollte Aktualisierung der UI deaktiviert sein - siehe Application.ScreenUpdating.
* Falls irgendwann Performance eine Rolle spielen sollte, empfiehlt sich - wie von Daniel gezeigt - die Transformation im Speicher durchzuführen und dessen Resultat ins Tabellenblatt zu schreiben.
* Die Debug-Zeilen kannst du gerne auskommentieren bzw. entfernen.

Ich würde mich hiermit aus dem Thema ausklinken. Für mich ist es erledigt.

Grüße

Bei deiner Spaltenberechnung warst du wohl nicht ganz bei der Sache?

Super, ich habs fast.

Bin jetzt nur noch gerade völlig überfordert wie ich die Ausgabe auf Tabelle 2 bekomme und die Daten in der Tabelle 1 sollen stehen bleiben.


Gruß

mal ohne Schnörkel, von wegen Array und sowas...

Sub unit()

  

  Dim lngTargetRow As Long

  Dim lngTargetCol As Long

  Dim lngW As Long

  Dim rngSource As Range

  Dim rngTarget As Range

  

  Set rngSource = ThisWorkbook.Worksheets("Tabelle1").Range("A4:A24")

  Set rngTarget = ThisWorkbook.Worksheets("Tabelle1").Range("B1")

    

  For lngW = 1 To rngSource.Rows.Count

        

    lngTargetRow = (lngW - 1) \ 3

    lngTargetCol = (lngW - 1) Mod 3

    

    rngTarget.Offset(lngTargetRow, lngTargetCol) = rngSource(lngW, 1).Value

        

  Next

  

End Sub

Super, Danke.

Hab jetzt 2 Lösungen die beide Funktionieren. Werde schauen welche für mich besser taugt.

Vielen Dank für eure Hilfe.

LG Chris

Sorry, wollte den Haken gar nicht setzen. Problem ist gelöst !!!

Um vielleicht noch den Bezug zu meinem Pseudo-Code herzustellen:

Sub unit()

  

  Dim lngTargetRow As Long

  Dim lngW As Long

  Dim lngJ As Long

  Dim lngM As Long

  Dim rngSource As Range

  Dim rngTarget As Range

  

  Set rngSource = ThisWorkbook.Worksheets("Tabelle1").Range("A4:A24")

  Set rngTarget = ThisWorkbook.Worksheets("Tabelle1").Range("B1")

    

  lngM = 3

  lngTargetRow = 0

  lngJ = 0

  

  For lngW = 1 To rngSource.Rows.Count

            

    rngTarget.Offset(lngTargetRow, lngJ) = rngSource(lngW, 1).Value

    lngJ = lngJ + 1

    If lngJ = lngM Then lngJ = 0: lngTargetRow = lngTargetRow + 1

    

  Next

  

End Sub

Das geht also auch ohne Ganzzahldivision und Modulo, ganz simpel.

Und du warst wohl bei der Ausformulierung deines Anliegens/Problems nicht ganz bei der Sache.

Falls du darauf anspielst, dass die Daten nicht auf Spalten sondern auf Zeilen aufgeteilt werden...
Das Verhalten zu korrigieren stellt nun wirklich kein Problem dar, wenn man das Prinzip nachvollzogen hat; einfach lngTargetRow und lngTargetCol miteinander tauschen. Die Berechnung bleibt die gleiche.

Grüße

ja nee, war gerade mit Eis essen abgelenkt, aber ich wollt dich halt doch drauf hinweisen, dass das nicht so ganz passt...
Im Übrigen würde ich die Bestimmung der Quell-Zeile so auch nicht .. und schon gar nicht zweimal machen wollen, aber gut...
Wichtig ist erst einmal "Make it Run", nichtwahr.

Angenommen du hast die Werte 1 bis N und möchtest die nacheinander in M Spalten schreiben und ggf. dann in der nächsten Zeile weiter machen..
Beginnen willst du in Zeile 2 und Spalte 3

Pseudocode:
Zeile = 2
Spalte = 3
J = 0 /* Spaltenzähler
Wiederhole mit W von 1 bis N
..schreibe in Zeile, (Spalte+J) den Wert(W)
../* nächste Spalte
..J = J+1
../* wenn letzte Spalte, dann neue Zeile
..wenn J=M dann J=0: Zeile=Zeile+1
Nächstes W

Das ist nur eine, von der Programmiersprache unabhängige Beschreibung einer möglichen Vorgehensweise. Im Grunde reflektiert es nur das, was du machst, wenn du es zu Fuss machst. Also weißt du schon irgendwo, wie das geht.

Sub Umwandeln()

Dim arr1

Dim arr2



Dim z1 As Long

Dim z2 As Long

Dim s2 As Long



Dim Spalten As Long

Dim Zeilen As Long





'--- Ausgangsdaten einlesen

With Sheets("Tabelle1")

    arr1 = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))

End With



'--- Dimensionierung

Spalten = 3

Zeilen = ((UBound(arr1, 1) - 1) \ Spalten) + 1

ReDim arr2(1 To Zeilen, 1 To Spalten)



'--- Zielarray erstellen

For z1 = 1 To UBound(arr1, 1)

    z2 = (z1 - 1) \ Spalten + 1

    s2 = (z1 - 1) Mod Spalten + 1

    arr2(z2, s2) = arr1(z1, 1)

Next



'--- Ergebnis in Tabelle

Sheets("Tabelle2").Cells(1, 1).Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2



End Sub