Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zwei voneinander abhängige Pivottabellen

Betrifft: Zwei voneinander abhängige Pivottabellen von: K-Pax
Geschrieben am: 08.11.2014 02:13:00

Hallo liebes Forum,
ich komme leider wieder mal nicht weiter....es ist doch erstaunlich wie viele mannigfaltige
Probleme sich bei der Programmierung immer wieder auftun :)
Wäre froh wenn mir jemand weiterhelfen könnte.

Also zu meinem Problemkind:

Ich habe zwei Pivottabellen in separaten Blättern, deren Daten aus einer SQL-Abfrage stammen.
Mit der einen hole ich mir die artikelnummern + Herstelldatum für einzelne Prozesse raus. D.h. Mein Hauptfilter ist hier Prozesse. Jetzt möchte ich gerne zu jeder Kombination artikelnummer+Herstelldatum eines Prozesses den Lagerort dazu haben. Unglücklicher Weise ist dieser aber nicht in diesem Datenblock vorhanden. Aber ich habe eine zweite Pivottabelle, die artikelnummer+herstelldatum mit dem Lagerort verbinden kann. Dort fehlt aber eben der Hauptfilter Prozesse. Nun habe ich mit Powerpivot schon versucht die beiden Tabellen zu verknüpfen, aber ich erhalte immer die Fehlermeldung, dass die Verknüpfungsspalte der beiden Tabellen mehrfachnennungen hat. Dadurch klappt das scheinbar nicht einen eindeutigen Bezug zu schaffen.

Daher kam die Idee zum Notfallplan...ein Makro
Ich sortiere in Tabelle 1 nach Prozess und erhalte eine Liste von verschiedenen Artikeln und zugehörigem Herstelldatum. Diese Liste kopiere ich in meine zweite Tabelle und möchte nun nacheinander jede Kombination Artikel+ Herstelldatum in die Hauptfilter eintragen, die Lagerorte davon kopieren und in eine dritte Tabelle eintragen in dafür vorgefertigten Bereichen. Danach wird der Nächte Artikel in Tabelle zwei gefiltert und wieder die Lagerorte kopiert und in Tabelle 3 eingetragen mit der Bedingung wenn Bereich 1 belegt dann schreibe in Bereich 2 USW.
Ich weiß, es ist jetzt nicht so gut zu veranschaulichen, nur kann ich von Zuhause aus die Datei nicht hochladen, daher versuche ich es so gut wie es geht zu beschreiben.

Von der Struktur sieht mein Makro ungefähr so aus:
Kopiere Liste der Artikelnummern+Herstelldatum in Tabelle 2.
For Zeile 1 to 50
If Herstelldatum vorhanden then
Hauptfilter1.value = .cells(Zeile, Spalte artikelnummer)
Hauptfilter2.value = .cells(Zeile, Spalte Herstelldatum)

If tabelle3 Bereich 1 unbelegt then
Copy Lagerorte in Bereich 1
Next
Elseif Bereich 2 unbelegt then
Copy Lagerorte in Bereich 2
Next
Usw.
End if

Folgende Probleme habe ich:
ohne die Bereiche in die kopiert werden soll abzufragen hatte ich am Anfang des Rumprobierens als es nur einen Bereich gab in den kopiert wurde auch tatsächlich die Lagerorte reinbekommen. Aber nur vom letzten Artikel. Endweder irgendwas läuft schief, oder weil einfach alle vorherigen Werte am Ende mit den letzten überschrieben werden. Es ging so schnell das Makro dass es mir vorkam als wäre ersteres der fall.
Ich habe mir auch Gedanken gemacht, ob man der Pivottabelle zeit geben muss mit application.wait damit sie sich nach ändern der Filter überhaupt anpassen kann, bevor sie kopiert werden kann mit den aktualisierten lagerorten. Muss man das? Wenn ja, wie lange?
Problem 2 entstand dann mit dem Prüfen ob der Bereich in den kopiert werden soll überhaupt noch frei ist und andernfalls in den nächsten Bereich reinkopiert werden soll. Denn irgendwie habe ich dadurch die For next schleife unterbrochen und verstehe nicht wodurch. Bekomme die Fehlermeldung next ohne for.

So viel Text ...hoffe es hat jemand einen Tip für mein Problem. Oder gar einen besseren Lösungsvorschlag bzw. Ein effizienteres und vor allem funktionierendes Makro.

Viele Grüße
K-Pax

  

Betrifft: AW: Zwei voneinander abhängige Pivottabellen von: K-Pax
Geschrieben am: 12.11.2014 07:22:39

Hallo nochmal.
Leider kam hier bis jetzt keine Antwort. Vielleicht war es ohne Bsp. auch zu schwierig zu verstehen.
Naja habs mittlerweile irgendwie hinbekommen. Zwar nicht unbedingt schön, aber immerhin.
Könnte mir vielleicht jemand noch Verbesserungen (Optimierungen) vorschlagen für den Code.
Insbesondere für das sub "copy"? Eine Schleife wäre deutlich eleganter. Ich kam nur nicht drauf, wie ich den Versatz dynamisch reinbekomme.

VG
K-Pax

Anbei nun auch der Code:

Option Explicit
Sub Lagerort_Trigger()
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    Sheets("tbl_Lagerorte").Range("A1:N76").ClearContents
    Sheets("Pivot_Lagerorte").Range("E1:K50").ClearContents
    Sheets("Pivot_Lagerorte").Range("M5:N50").ClearContents
    Sheets("Prozesse").Range("A1:G50").copy
    Sheets("Pivot_Lagerorte").Range("E1") _
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("tbl_Lagerorte").Range("P1").Value = Sheets("Pivot_Lagerorte").Range("F5").Value
    Sheets("tbl_Lagerorte").Range("Q1").Value = "FA" & " " & Sheets("Pivot_Lagerorte").Range(" _
E5").Value
    Sheets("Pivot_Lagerorte").Range("I5:I50").copy
    Sheets("Pivot_Lagerorte").Range("M5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  _
SkipBlanks _
        :=False, Transpose:=False
    Sheets("Pivot_Lagerorte").Range("G5:G50").copy
    Sheets("Pivot_Lagerorte").Range("N5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  _
SkipBlanks _
        :=False, Transpose:=False
    Sheets("Pivot_Lagerorte").Range("F5").copy
    
    Call Herstelldatum_zuText 'durch das Umwandeln zu Text soll vermieden werden, dass die  _
Pivottabelle mit den Werten eventuell nicht klarkommt.
    Call Artikelnummer_zuText
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Call Lagerorte
    
End Sub
Sub Herstelldatum_zuText()
  With Worksheets("Pivot_Lagerorte")
    'Zahlen in Spalte 12 in Text umwandeln
    Call NumbersToText(Bereich:=.Range(.Cells(5, 13), .Cells(.Rows.Count, 13).End(xlUp)))
  End With
End Sub

Sub Artikelnummer_zuText()
  With Worksheets("Pivot_Lagerorte")
    'Zahlen in Spalte 13 in Text umwandeln
    Call NumbersToText(Bereich:=.Range(.Cells(5, 14), .Cells(.Rows.Count, 14).End(xlUp)))
  End With
End Sub

Sub NumbersToText(Bereich As Range)
  'fügt vor Zahlen ein Hochkomma ein zur Umwandlung in Text
  'sinnvoll bei Ziffernfolgen, die eigentlich keine Zahlen sind (PLZ, Artikelnummern etc.)
  Dim Zelle As Range
  For Each Zelle In Bereich
    If Not IsEmpty(Zelle.Text) Then
      
        Zelle.Value = "'" & Zelle.Text
        If Zelle.Offset(0, -1).Value = "" Then
        Zelle.Value = ""
      End If
    End If
   
  Next
End Sub

Sub Lagerorte()
Dim Zeile As Long, ws As Worksheet
Dim Spalte As Long
On Error GoTo ErrorHandler
    
Set ws = Worksheets("Pivot_Lagerorte")
With ws
       With Application
       .ScreenUpdating = False
       .EnableEvents = False
       .Calculation = xlCalculationManual
       End With
  For Zeile = 5 To 50 'Zeilen ab Zeile 1 bis 50 abarbeiten
      If .Cells(Zeile, 13).Value <> "" And .Cells(Zeile, 14) <> "" Then 'Prüfen, ob Wertepaare  _
in Spalte M und N vorhanden
        .PivotTables("PVT").RefreshTable
        .PivotTables("PVT").ClearAllFilters
        .PivotTables("PVT").PivotFields("Artikelnummer").CurrentPage = .Cells(Zeile, 14).Value
        .PivotTables("PVT").PivotFields("Herstelldatum").CurrentPage = .Cells(Zeile, 13).Value
        Call copy
      Else
      End If
      
  Next
  End With
    Sheets("tbl_Lagerorte").Select
    Range("A1").Select
    With Application
         .CutCopyMode = False
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = xlCalculationAutomatic
    End With

ErrorHandler:
    Resume Next
End Sub


Sub copy()
        ' hier soll nun so eingefügt werden, dass man eine Tabelle erhält mit je drei Blöcken  _
je Reihe. _
        Ist eine Reihe voll soll die nächste Reihe wieder in der ersten Spalte beginnen usw. _
        Kann man das auch in einer Schleife machen? Ich wusste nicht wie ich den Versatz  _
hinbekomme.
        
        Worksheets("Pivot_Lagerorte").Range("A1:D10").copy
        
        If Sheets("Lagerorte").Range("A1") = "" Then
        Sheets("Lagerorte").Range("A1" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F1") = "" Then
        Sheets("Lagerorte").Range("F1" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K1") = "" Then
        Sheets("Lagerorte").Range("K1" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("A12") = "" Then
        Sheets("Lagerorte").Range("A12" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F12") = "" Then
        Sheets("Lagerorte").Range("F12" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K12") = "" Then
        Sheets("Lagerorte").Range("K12" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("A23") = "" Then
        Sheets("Lagerorte").Range("A23" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F23") = "" Then
        Sheets("Lagerorte").Range("F23" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K23") = "" Then
        Sheets("Lagerorte").Range("K23" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("A34") = "" Then
        Sheets("Lagerorte").Range("A34" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F34") = "" Then
        Sheets("Lagerorte").Range("F34" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K34") = "" Then
        Sheets("Lagerorte").Range("K34" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("A45") = "" Then
        Sheets("Lagerorte").Range("A45" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F45") = "" Then
        Sheets("Lagerorte").Range("F45" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K45") = "" Then
        Sheets("Lagerorte").Range("K45" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("A56") = "" Then
        Sheets("Lagerorte").Range("A56" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F56") = "" Then
        Sheets("Lagerorte").Range("F56" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K56") = "" Then
        Sheets("Lagerorte").Range("K56" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("A67") = "" Then
        Sheets("Lagerorte").Range("A67" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("F67") = "" Then
        Sheets("Lagerorte").Range("F67" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ElseIf Sheets("Lagerorte").Range("K67") = "" Then
        Sheets("Lagerorte").Range("K67" _
        ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

        
        
        Else: MsgBox ("Nicht genug freie Felder, bitte wende dich an den Administrator")
         
      End If
     
      
      
End Sub



  

Betrifft: AW: Zwei voneinander abhängige Pivottabellen von: Armin
Geschrieben am: 14.11.2014 09:46:38

Grüße Dich K-Pax,

da deine Pivottabellen aus einer SQL-Abfrage stammen, gibt es vielleicht die Möglichkeit das ganze über das Add-In "PowerPivot" zu lösen.
hier gibt es die Möglichkeit mehrere Tabellen in einer Abfrage zusammen zu fassen und auch die Tabellen miteinander zu verknüpfen.
Prüfe mal ob sich in den beiden Abfragen ein gleiches Feld findet mit dem eine Verknüpfung möglich ist.

Viele Grüße
Armin


  

Betrifft: AW: Zwei voneinander abhängige Pivottabellen von: K-Pax
Geschrieben am: 14.11.2014 18:31:20

Hallo Armin,
danke für den Tip. Aber wie bereits in meinem ersten Post geschrieben, habe ich das schon probiert.
Das ist leider gescheitert, da die überschneidende Spalte mehrfachnennungen hat. Daher kann auch Powerpivot keine eindeutige Verknüpfung herstellen.
Trotzdem Danke.

Viele Grüße
K-Pax


  

Betrifft: AW: Zwei voneinander abhängige Pivottabellen von: Armin
Geschrieben am: 17.11.2014 11:47:13

Grüße Dich K-Pax,
hätte ich doch mal den ersten Post richtig gelesen.
Ich nehme an das du als Verknüpfungsfeld die Artikelnummer oder das Herstellungsdatum genommen hast.
Diese kommen dann in beiden Abfragen häufiger vor.
Gibt es denn für die Artikel eine Stammdaten-Tabelle in der die Artikelnummer nur einmal vorkommt.
Binde diese Tabelle als dritte Tabelle mit ein und verknüpfe zu den anderen beiden (1:n).

Viele Grüße
Armin


 

Beiträge aus den Excel-Beispielen zum Thema "Zwei voneinander abhängige Pivottabellen"