AW: Tabelle anpassen / Spalte entfernen
22.05.2019 15:13:13
Steve
Moin,
das hier habe ich bisher.
Sub Spalte()
'Die Anzeige auf dem Bildschirm wird eingefroren um ein "Flimmern" zu vermeiden, wenn Arbeitsblä _
tter durch das Makro gewechselt werden
Application.ScreenUpdating = False
'Vorhandene Pivot wird gelöscht
Sheets("Daten1").Select
Columns("A:ZZ").Select
Selection.Delete Shift:=xlToLeft
'Neue Pivot wird erstellt und "Daten" genannt
Range("A1:A2").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$A$2"), , xlYes).Name = _
"Datum"
Columns("A:A").Select
Selection.NumberFormat = "dd/mm/yy;@"
Worksheets("Eingabe").Activate
'Sucht die letzte beschriebene Spalte in der ersten Zeile
'Hier muss die 256 ggf. angepasst werden, falls die Zieltabelle auf dem selben Tabellenblatt _
erzeugt werden soll
letztespalte = Sheets("Eingabe").Cells(1, 256).End(xlToLeft).Column
'jede gefüllte Spalte wird durchgelaufen
For s = 1 To letztespalte
Eingabe = Cells(1, s).Value
'Wenn der Inhalt der geprüften Zelle nicht Fahrer oder Beifahrer ist, dann...
If Cells(1, s).Value "Fahrer" And Cells(1, s).Value "Beifahrer" Then
'...wird der Inhalt der Zelle in die Variable aufgenommen (.value steht immer für "Inhalt der _
Zelle")
'Ansonsten wird die Prozedur übersprungen und es wird zum "End if" (siehe Ende des Makros) _
gesprungen
variable = Cells(1, s).Value
'Tabellenblatt mit der Zieldatei wird geöffnet
Worksheets("Daten1").Activate
'In die erste Zelle wird "Datum" geschrieben
Cells(1, 1).Value = "Datum"
'Tabellenblatt mit der Zieldatei wird geöffnet
Worksheets("Daten1").Activate
'In die erste Zelle wird "Datum" geschrieben
Cells(1, 2).Value = "Team"
'die letzte beschriebene Zelle wird ermittelt (jedes Mal neu, da jedes Mal eine neue Spalte _
beschrieben wird und sich der Wert dadurch ändert)
letztespalteZiel = Sheets("Daten1").Cells(1, 256).End(xlToLeft).Column
'In die Spalte neben der letzten beschriebenen Spalte wird der variable Wert eingetragen
Cells(1, letztespalteZiel + 1).Value = variable
'Die Tabelle mit der Ursprungsdatei wird wieder geöffnet
Worksheets("Eingabe").Activate
End If
'Die nächste Spalte in den Rohdaten wird überprüft und übertragen
Next s
Sheets("Eingabe").Select
'Es wird geprüft, wie viele Zeilen es in der "Spalte B" gibt. Die "2" steht für den zweiten _
Buchstaben im Alphabet (B)
LetzteZeile = ActiveSheet.Cells(1048576, 3).End(xlUp).Row
'In der Matrix werden alle "Fahrer" markiert.
Range("Matrix[Fahrer]").Select
'Die Auswahl wird kopiert
Selection.Copy
Sheets("Daten1").Select
'Die kopierte Auswahl wird in der "Spalte B" eingefügt (Ab der ersten Zeile)
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Eingabe").Select
'In der Matrix werden alle "Beifahrer" markiert.
Range("Matrix[Beifahrer]").Select
'Die Auswahl wird kopiert
Application.CutCopyMode = False
Selection.Copy
Sheets("Daten1").Select
'Die kopierten Beifahrer werden in "Spalte B" (2. Buchstabe im Alphabet) unter die _
bereits vorhandenen Fahrer geschrieben
'Der Ausdruck "letztezeile-0" ist die erste freie Zelle unter den Fahrern
Range(Cells(LetzteZeile + 1, 2), Cells(LetzteZeile + 1, 2)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Sheets("Eingabe").Select
'Es wird geprüft, wie viele Zeilen es in der "Spalte A" gibt. Die "1" steht für den ersten _
Buchstaben im Alphabet (A)
LetzteZeile = ActiveSheet.Cells(1048576, 5).End(xlUp).Row
'In der Matrix werden alle "Datum" markiert.
Range("Matrix[Datum]").Select
'Die Auswahl wird kopiert
Selection.Copy
Sheets("Daten1").Select
'Die kopierte Auswahl wird in der "Spalte A" eingefügt (Ab der ersten Zeile)
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Eingabe").Select
'In der Matrix werden alle "Datum" markiert.
Range("Matrix[Datum]").Select
'Die Auswahl wird kopiert
Application.CutCopyMode = False
Selection.Copy
Sheets("Daten1").Select
'Die kopierten "Datum" werden in "Spalte A" (1. Buchstabe im Alphabet) unter die _
bereits vorhandenen "Datum" geschrieben
'Der Ausdruck "letztezeile-0" ist die erste freie Zelle unter dem Datum
Range(Cells(LetzteZeile + 1, 1), Cells(LetzteZeile + 1, 1)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AA:AA").Select
Application.CutCopyMode = False
'Der "eingefrorene" Bildschirm wird wieder freigeschaltet, damit die Änderungen sichtbar _
werden
Application.ScreenUpdating = True
End Sub