Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1380to1384
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Pivot Daten strukturieren

Pivot Daten strukturieren
23.09.2014 16:02:00
Sebastian
Hallo zusammen,
ich habe Daten in folgender Struktur vorliegen (siehe Link)
https://www.herber.de/bbs/user/92770.xlsx
Und möchste diese mit Pivot oder anderst in folgede Struktur bringen. (siehe Link)
Für jede Teilenummer soll demnach nur noch eine Zeile entstehen.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivot Daten strukturieren
23.09.2014 17:35:32
fcs
Hallo Sebastian,
per Pivottabellenbericht kannst du deine Liste nicht in die gewünschte Struktur bringen.
Das geht nach meiner Einschätzung nur per Makkro.
Nachfolgend ein entsprechendes Makro, das du ggf. noch ein wenig anpassen muss.
Einfügen musst du es in einem allgemeinen Modul der Datei im VBA-Editor.
Gruß
Franz
Sub Aufbereiten_Teile_Preise()
Dim wksTeile As Worksheet
Dim wksErgebnis As Worksheet
Dim ZeileE As Long, ZeileT As Long, SpalteE As Long
Dim varTeil, varWerk, varLief, varCur, varPreis
Dim arrTeile As Variant, arrErgebnis As Variant
Set wksTeile = Worksheets("Tabelle1")
Set wksErgebnis = Worksheets("Tabelle3")
With wksTeile
arrTeile = .Range(.Cells(7, 2), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 4))
End With
ReDim arrErgebnis(LBound(arrTeile, 1) To UBound(arrTeile, 1), 1 To 28)
ZeileE = LBound(arrErgebnis, 1) - 1
For ZeileT = LBound(arrTeile, 1) To UBound(arrTeile, 1)
varWerk = arrTeile(ZeileT, 2)
varLief = arrTeile(ZeileT, 3)
varCur = arrTeile(ZeileT, 4)
varPreis = arrTeile(ZeileT, 5)
If varTeil  arrTeile(ZeileT, 1) Then
varTeil = arrTeile(ZeileT, 1)
ZeileE = ZeileE + 1
arrErgebnis(ZeileE, 1) = varTeil
End If
SpalteE = 0
Select Case varWerk
Case "EU": SpalteE = 2
Case "JP": SpalteE = 11
Case "US": SpalteE = 20
End Select
If SpalteE > 0 Then
If arrErgebnis(ZeileE, SpalteE) = "" Then
ElseIf arrErgebnis(ZeileE, SpalteE + 3) = "" Then
SpalteE = SpalteE + 3
ElseIf arrErgebnis(ZeileE, SpalteE + 6) = "" Then
SpalteE = SpalteE + 6
Else
SpalteE = 0
End If
End If
If SpalteE > 0 Then
arrErgebnis(ZeileE, SpalteE) = varLief
arrErgebnis(ZeileE, SpalteE + 1) = varCur
arrErgebnis(ZeileE, SpalteE + 2) = varPreis
End If
Next ZeileT
With wksErgebnis
With .UsedRange
ZeileT = .Row + .Rows.Count - 1
End With
If ZeileT > 3 Then
.Range(.Rows(3), .Rows(ZeileT)).Clear
End If
.Cells(3, 2).Resize(UBound(arrErgebnis, 1), 28) = arrErgebnis
With .Cells(3, 2).Resize(ZeileE, 28)
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
.Activate
End With
Erase arrTeile, arrErgebnis
End Sub

Anzeige
AW: Pivot Daten strukturieren
23.09.2014 19:15:57
Sebastian
Hallo Franz,
vielen Dank für deine schnelle Antwort. Ich habe bereits einige Tests gemacht. Funtioniert bisher sehr gut. Ich schaue es mir morgen noch genauer an. Muss noch weiter Werke hinzufügen. Hoffe das ich das bei deinem Code schaffe. :-)
Meld mich morgen nochmal.
Nochmals Danke und Grüße
Sebastian

AW: Pivot Daten strukturieren
23.09.2014 19:36:22
Sebastian
Hallo Franz,
ich hatte nun doch die Möglichkeit heute noch genauer drauf zu schauen. Ich versteh den Code nicht ganz.
Könntest du mir bitte noch sagen wie ich das Makro so anpasse, dass ich insgesamt 9 Werke nebeneinander stehen habe.
Hatte im Bsp nur 3 aufgelistet, die Orginaldaten enthalen aber 9.
Danke und Gruß.

Anzeige
AW: Pivot Daten strukturieren
24.09.2014 10:45:47
Sebastian
Habe den Code noch noch anpassen können. Funktioniert perfekt. Danke :-)

AW: Daten-Liste neu strukturieren
24.09.2014 11:33:31
fcs
Hallo Sebastian,
für 9 Werke muss im Code die 28 (=Anzahl der Spalten im Ergebnisarray) geändert werden in (1 + Anzahlwerke * 9) und es müssen entsprechende Case-Zeilen eingefügt werden, wobei die Nummer der Spalte zum Werk um jeweils 9 erhöht wird.
Gruß
Franz
Sub Aufbereiten_Teile_Preise_neu()
Dim wksTeile As Worksheet
Dim wksErgebnis As Worksheet
Dim ZeileE As Long, ZeileT As Long, SpalteE As Long
Dim varTeil, varWerk, varLief, varCur, varPreis
Dim arrTeile As Variant, arrErgebnis As Variant
Dim AnzahlWerke As Integer                            '##2014-09-24
AnzahlWerke = 9  'Anzahl Werke                        '##2014-09-24
Set wksTeile = Worksheets("Tabelle1")
Set wksErgebnis = Worksheets("Tabelle3")
With wksTeile
arrTeile = .Range(.Cells(7, 2), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 4))
End With
ReDim arrErgebnis(LBound(arrTeile, 1) To UBound(arrTeile, 1), 1 To (1 + AnzahlWerke * 9)) '## _
2014-09-24
ZeileE = LBound(arrErgebnis, 1) - 1
For ZeileT = LBound(arrTeile, 1) To UBound(arrTeile, 1)
varWerk = arrTeile(ZeileT, 2)
varLief = arrTeile(ZeileT, 3)
varCur = arrTeile(ZeileT, 4)
varPreis = arrTeile(ZeileT, 5)
If varTeil  arrTeile(ZeileT, 1) Then
varTeil = arrTeile(ZeileT, 1)
ZeileE = ZeileE + 1
arrErgebnis(ZeileE, 1) = varTeil
End If
'Spalte des Werks ermitteln
SpalteE = 0
Select Case varWerk
Case "EU": SpalteE = 2
Case "JP": SpalteE = 11
Case "US": SpalteE = 20
Case "X4": SpalteE = 29               '##2014-09-24
Case "X5": SpalteE = 38               '##2014-09-24
Case "X6": SpalteE = 47               '##2014-09-24
Case "X7": SpalteE = 56               '##2014-09-24
Case "X8": SpalteE = 65               '##2014-09-24
Case "X9": SpalteE = 74               '##2014-09-24
End Select
If SpalteE > 0 Then
If arrErgebnis(ZeileE, SpalteE) = "" Then
ElseIf arrErgebnis(ZeileE, SpalteE + 3) = "" Then
SpalteE = SpalteE + 3
ElseIf arrErgebnis(ZeileE, SpalteE + 6) = "" Then
SpalteE = SpalteE + 6
Else
SpalteE = 0
End If
End If
If SpalteE > 0 Then
arrErgebnis(ZeileE, SpalteE) = varLief
arrErgebnis(ZeileE, SpalteE + 1) = varCur
arrErgebnis(ZeileE, SpalteE + 2) = varPreis
End If
Next ZeileT
With wksErgebnis
With .UsedRange
ZeileT = .Row + .Rows.Count - 1
End With
If ZeileT > 3 Then
.Range(.Rows(3), .Rows(ZeileT)).Clear
End If
.Cells(3, 2).Resize(UBound(arrErgebnis, 1), (1 + AnzahlWerke * 9)) = arrErgebnis '##2014-09- _
24
With .Cells(3, 2).Resize(ZeileE, (1 + AnzahlWerke * 9))            '##2014-09-24
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
.Activate
End With
Erase arrTeile, arrErgebnis
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige