Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Pivot Daten strukturieren

Betrifft: Pivot Daten strukturieren von: Sebastian
Geschrieben am: 23.09.2014 16:02:00

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.

  

Betrifft: AW: Pivot Daten strukturieren von: fcs
Geschrieben am: 23.09.2014 17:35:32

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



  

Betrifft: AW: Pivot Daten strukturieren von: Sebastian
Geschrieben am: 23.09.2014 19:15:57

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


  

Betrifft: AW: Pivot Daten strukturieren von: Sebastian
Geschrieben am: 23.09.2014 19:36:22

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ß.


  

Betrifft: AW: Pivot Daten strukturieren von: Sebastian
Geschrieben am: 24.09.2014 10:45:47

Habe den Code noch noch anpassen können. Funktioniert perfekt. Danke :-)


  

Betrifft: AW: Daten-Liste neu strukturieren von: fcs
Geschrieben am: 24.09.2014 11:33:31

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