Daten aus Spalten in Zeilen schreiben

[Ralfons73]

:24:Hallo zusammen

ich habe Daten in folgendem Format vorliegen (Anhang: DATEN_IST)
   

Hier werden für verschiedene Materialnummern die Stückzahlen für jeden Tag angezeigt. Jedes Material hat eine Zeile und eine fixe Anzahl an Spalten mit Datum und der zugehörigen Stückzahl.

Nun möchte ich diese gerne so umwandeln, dass es für jedes Datum eine eigene Zeile gibt. In meinem Beispiel wären das als 9 Zeilen (tatsächlich sind es zwischen 100 und 300 Materialien und 70 Spalten, was den manuellen Aufwand etwas sprengen würde).

Das Ganze sollte also folgendermaßen aussehen: (Anhang DATEN_SOLL):
   

Hab mir schon überlegt, ein 2. Arbeitsblatt anzulegen, in das ich die Spalen einfach transformiere aber das erscheint mir dann doch etwas ungeschickt.

Ich würde mich sehr über einen guten Tipp freuen.

Grüße
Ralf

[Kuwer]

Hallo Ralf,

so z.B.: (Tabellennamen entsprechend anpassen!)

Code:

Sub Makro2()
  Dim i As Long, lngZielzeile As Long
  Dim rngD As Range, rngG As Range
  Set rngG = Worksheets("Daten_Ist").Range("A1").CurrentRegion
  Set rngD = rngG.Offset(, 1).Resize(, rngG.Columns.Count - 1)
  Application.ScreenUpdating = False
  With Worksheets("Daten_Soll")
    .Range("A1").Value = rngG.Cells(1, 1).Value
    .Range("B1").Value = "Datum"
    .Range("C1").Value = "Qty"
    For i = 2 To rngG.Rows.Count
      lngZielzeile = .Cells(Rows.Count, 2).End(xlUp).Row + 1
      rngG.Cells(i, 1).Copy .Cells(lngZielzeile, 1)
      Application.Union(rngD.Rows(1), rngD.Rows(i)).Copy
      .Cells(lngZielzeile, 2).PasteSpecial Transpose:=True
      .Range(.Cells(lngZielzeile, 1), .Cells(.Rows.Count, 2).End(xlUp).Offset(, -1)).Value = .Cells(lngZielzeile, 1).Value
    Next i
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[coemm]

Hallo Ralf,

das geht auch ohne Makro.

Schau mal hier
(incl. Video)

[schauan]

Halöchen,

das müsstest Du dann mehrfach Transponieren. Das kann auch unterhalb der bisherigen Daten geschehen, ein neues Blatt brauchst Du nicht. Die Daten werden positionsweise (Mat1, Mat2 usw) zusammengefasst. Nach jeder Position kannst Du die Zeile der Position löschen und dann die nächste Position transponieren.
Allerdings ist unklar, wo die City her kommt.

Falls Du mal so was neu Aufbauen musst könnte man so vorgehen. Du könntest da eine Tabelle mit eine Hilfsspalte aufbauen.

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C
1	Mat1	02.12.2014	FALSCH
2	Mat1	03.12.2014	FALSCH
3	Mat1	04.12.2014	FALSCH
4	Mat1	05.12.2014	FALSCH
5	Mat1	06.12.2014	WAHR
6	Mat1	07.12.2014	WAHR
7	Mat1	08.12.2014	FALSCH

Zelle	Formel
C1	=WOCHENTAG(B1;2)>5
C2	=WOCHENTAG(B2;2)>5
C3	=WOCHENTAG(B3;2)>5
C4	=WOCHENTAG(B4;2)>5
C5	=WOCHENTAG(B5;2)>5
C6	=WOCHENTAG(B6;2)>5
C7	=WOCHENTAG(B7;2)>5

Diese Tabelle wurde mit Tab2Html (v2.5.0) erstellt. ©Gerd alias Bamberg

Du ziehst die mit Mat1 so weit runter wie nötig, sortierst nach Spalte C, löschst alles mit WAHR in Spalte C .. Dann kopierst Du alles, setzt es unter den Bereich und ersetzt im eingefügten Teil Mat1 durch Mat2 - dann weiter mit Mat3 usw.

[atilla]

Hallo,

unten von mir auch eine Variante.

Folgendes setze ich voraus:
-Es existiert ein Blatt mit Namen "DATEN_IST"
-Es existiert ein Blatt mit Namen "DATEN_SOLL"
-In Tabelle "DATEN_IST" ist der Datenbereich als Tabelle "DATEN_IST" benannt (in Tabelle formatiert)

Der Code schreibt die Ergebnisse in Tabelle "DATEN_SOLL"
Der Inhalt der gesamten Tabelle "DATEN_SOLL" wird vorher gelöscht.

Das ist der Code dazu:

Code:

Sub tranponieren()
   Dim i As Long, j As Long, k As Long, n As Long
   Dim lngS As Long, lngZ As Long
   Dim vntA As Variant
   Dim feld As Variant
   Dim arr()
  
   vntA = Array("MatNr_Descr", "Datum", "Qty")
   With Sheets("DATEN_IST")
      lngS = .Range("Daten_Ist").Columns.Count
      lngZ = .Range("Daten_Ist").Rows.Count
      feld = .Range(.Cells(1, 1), .Cells(lngZ + 1, lngS + 1))
      ReDim arr(2, (lngS * (lngZ + 1)) - 1)
         For i = 1 To lngZ
            For j = 1 To lngS - 1
               arr(0, k + j) = feld(i + 1, 1)
               arr(1, k + j) = feld(1, j + 1)
               arr(2, k + j) = feld(i + 1, j + 1)
            Next j
            k = k + j - 1
         Next i
   End With
  
   With Sheets("DATEN_SOLL")
      .Cells.ClearContents
      .Range("A1:C1").Resize(i * j) = Application.Transpose(arr)
      .Range("A1:C1") = vntA
   End With
End Sub

Das sollte etwas schneller laufen als die Variante von Uwe.

@Uwe
Du leerst den Zielbereich vor dem kopieren nicht. Mich wundert aber auch, dass gerade Du eine Lösung mit Copy und Paste anbietest.
Bei 300 Zeilen und 70 Spalten dauert es halt ein wenig.

[Kuwer]

Hallo Zusammen,

schade, dass es hier keine gewisse Forumskultur gibt.
Ich würde hier wahrscheinlich nur einmal eine Frage stellen.

Gruß Uwe

[Peter]

Hallo Uwe,

schade, dass es hier keine gewisse Forumskultur gibt.

was meinst du damit genau?

[Kl@us-M.]

Hallo Uwe,

schade, dass es hier keine gewisse Forumskultur gibt.

was meinst du damit genau?

Das würde mich jetzt auch mal brennend interessieren

[atilla]

Hallo Uwe,

ich bin sprachlos.
Bis Du Dir über die Tragweite Deiner Aussage bewusst?

Deine Aussage betrifft nicht nur Conny, Andre und mich, sonder alle Beteiligten des Forums und letztendlich das Forum selbst.

Wenn ich mich daneben benommen haben sollte, dann habe ich niemals ein Problem damit, dass mir das
persönlich auf direktem Wege gesagt wird. Wir sind alle Erwachsene hier und sollten Klartext verstehen
und annehmen können.

So wie Peter und Klaus bin ich sehr an einer weiterführenden Erklärung interessiert. Ich möchte gerne wissen, was ich falsch gemacht habe. (Ich bezieh Deine Äußerungen jetzt mal auf mich)

[Ralfons73]

Hallo zusammen

besten Dank für die Antworten. Ich habe mich bisher immer erfolgreich um VBA drücken können, aber werde mich nun mit dem Thema beschäftigen.

Bis die Kritik an der Forenkultur aufkam ist mir hier ehrlichgesagt nichts komisch vorgekommen. Schnelle Antworten, freundlicher Umgangston. Hab schon Schlimmeres erlebt.

Grüße
Ralf