Datumsangabe sehr speziell transponieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo namensvetter Franz,
hier eine Makrolösung
Gruß
Franz Sub prcTransformation() Dim wksQ As Worksheet Dim wksZ As Worksheet Dim rngQ As Range, ZelleQ As Range, Datum As Long, DatumMin As Long, DatumMax As Long Dim Zeile As Long, ZeileZ As Long, SpalteZ As Long Dim bolGefunden As Boolean Dim arrBlock, intBlock, arrRngQ() As Range Const ZeileQ1 = 4 '1. Zeile mit Datum unter Gruppenname Set wksQ = ActiveSheet arrBlock = Array(20, 26, 30) 'Spalten-Nummern mit den Gruppen-Daten ReDim arrRngQ(0 To UBound(arrBlock)) 'neues Blatt einfügen Set wksZ = ActiveWorkbook.Worksheets.Add(after:=wksQ) ZeileZ = 3 '1. Zeile für transponierte Daten SpalteZ = 1 'Einfügespalte für transponierte Daten With wksQ DatumMin = 9999999 For intBlock = 0 To UBound(arrBlock) 'Letzte Datenzeile in Gruppe Zeile = .Cells(.Rows.Count, arrBlock(intBlock)).End(xlUp).Row 'Zellbereich mit den Datumswerten Set arrRngQ(intBlock) = .Range(.Cells(ZeileQ1, arrBlock(intBlock)), _ .Cells(Zeile, arrBlock(intBlock))) With Application.WorksheetFunction DatumMin = .Min(DatumMin, .Min(arrRngQ(intBlock))) DatumMax = .Max(DatumMax, .Max(arrRngQ(intBlock))) End With 'Spaltentitel kopieren .Cells(ZeileQ1 - 1, arrBlock(intBlock)).Copy With wksZ.Cells(ZeileZ + intBlock, SpalteZ) .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteValues End With Application.CutCopyMode = False Next End With 'Datumsbereich abarbeiten For Datum = DatumMin To DatumMax bolGefunden = False For intBlock = 0 To UBound(arrBlock) 'Datum mit vorhandenen Datumswerten vergleichen For Each ZelleQ In arrRngQ(intBlock) If ZelleQ = Datum Then If bolGefunden = False Then 'wenn Datum das 1. mal übereinstimmt, dann Zielspaltenzähler erhöhen SpalteZ = SpalteZ + 1 bolGefunden = True End If 'Datum in Zieltabelle eintragen wksZ.Cells(ZeileZ + intBlock, SpalteZ).Value = Datum End If Next Next intBlock Next With wksZ 'Datumszeilen in Zieltabelle formatieren For Zeile = ZeileZ To ZeileZ + UBound(arrBlock) With .Range(.Cells(Zeile, 2), .Cells(Zeile, SpalteZ)) .NumberFormat = "D.M" 'Datumsformat .Font.Color = wksZ.Cells(Zeile, 1).Font.Color 'Fontfarbe .EntireColumn.ColumnWidth = 5 'Spaltenbreite .HorizontalAlignment = xlCenter 'Zentrieren in zellen End With Next 'Zellen mit Datum bedingt formatieren 'wenn ein Datum bei mehreren Gruppen identisch ist, dann gelb With .Range(.Cells(ZeileZ, 2), .Cells(ZeileZ + UBound(arrBlock), SpalteZ)) ' .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=UND(B" & ZeileZ & """"";ANZAHL2(B$" & ZeileZ & ":B$" _ & ZeileZ + UBound(arrBlock) & ")>1)" .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=UND(ZS"""";ANZAHL2(Z" & ZeileZ & "S:Z" & ZeileZ + UBound(arrBlock) & "S)>1)" .FormatConditions(.FormatConditions.Count).SetFirstPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 65535 'gelb .TintAndShade = 0 End With .FormatConditions(1).StopIfTrue = True End With End With Erase arrRngQ, arrBlock End Sub

Hallo Franz W,
... allerdings wäre nachfolgende Formel in XL 2007/2010 fast 50% kürzer und schneller.
Meine Formel setzt momentan nur voraus, dass die Datumswerte in der von Dir angegeben Spalten stehen. Zwischen den Spalten kann stehen was will. In der Zieltabelle ist auch egal welche Texte in A3:A5 stehen, es dürfen nur keine reine Zahlenwerte dort stehen (was auch nicht der Fall sein sollte)
Dann in B3 folgende Formel (für XL2003) die Du nach rechts und unten kopieren kannst. Dein zus. spezif. Wunsch, dass max. 60 Spalten gefüllt werden, könntest Du mit entsprechenden Drucklayout (wiederholende Spalten links) abfangen. Unabhängig davon würde ich nur Datumswerte ab/nach einem von Dir vorgegebenen Datum (z.B. HEUTE() -##) listen lassen. Auch das könnte in der Formel noch untergebracht werden. Zu evtl. Anpassungen in den nächsten Tagen komme ich wahrscheinlich nicht.

	A	B	C	D	E	F	G	H	I
3	1. Gruppe			10.1.			22.1.
4	2. Gruppe	7.1.			14.1.	21.1.		26.1.	28.1.
5	3. Gruppe		8.1.					26.1.

Formeln der Tabelle

Zelle

Formel

{=WENN(ISTFEHLER(VERGLEICH(KKLEINSTE(WENN(ISTZAHL(VERGLEICH(SPALTE($T:$AD); {20;26;30};))*(Tab_1!$T$4:$AD$99<>""); Tab_1!$T$4:$AD$99); ANZAHL($A$3:A$5)+1); INDEX(Tab_1!$T$4:$AD$99;;INDEX({1;7;11};ZEILE(A1))); )); "";INDEX(Tab_1!$T:$AD;VERGLEICH(KKLEINSTE(WENN(ISTZAHL(VERGLEICH(SPALTE($T:$AD); {20;26;30};))*(Tab_1!$T$4:$AD$99<>""); Tab_1!$T$4:$AD$99); ANZAHL($A$3:A$5)+1); INDEX(Tab_1!$T$4:$AD$99;;INDEX({1;7;11};ZEILE(A1))); )+3;INDEX({1;7;11};ZEILE(A1))))}

Enthält Matrixformel:
Umrandende { } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Werner
.. , - ...

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F	G	H	I	J	K	L
3	Gruppe1:			10.1.			22.1.				4.2.	5.2.
4	Gruppe2:	7.1.			14.1.	21.1.		26.1.	28.1.		4.2.
5	Gruppe3:		8.1.					26.1.		3.2.

Datumsangabe sehr speziell transponieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread