Hallo Leute,
ich möchte die von einem Kunden bestellten Erzeugnisse den dazugehörigen Einzelkomponenten zuordnen. Und zwar mittels Makro.
Unterm Strich kriege ich das auch hin, nur leider arbeite ich dabei mit dem Aufzeichnungstool und Pivottabellen und komme mir ziemlich plump vor.
Was mich jetzt brennend interessiert: Wisst ihr einen eleganteren Weg, um diese Aufgabe mittels VBA zu meistern?
Die Datei liegt anbei. Meine Makros habe ich aber sicherheitshalber mal entfernt. :s
Danke im Voraus!
Hallo,
Daß Du eine Datei ohne Makros geliefert hast, ist völlig ok, da Du sonst eine
nicht unerhebliche Menge Helfer ausschließen würdest die Bedenken haben,
eine Datei mit Makros downzuloaden.
Also mich würden Deine Makros schon interessieren da das die Arbeit wesentlich
verkürzen und auch ein besseres Verständnis dafür geben würde, was Dir denn
wirklich so vorschwebt ... das ist meine Meinung ... .
Hi,
Zitat:Meine Makros habe ich aber sicherheitshalber mal entfernt.
das ist völlig OK. Du solltest uns aber den Makrotext zur Verfügung stellen. Bitte kopiere ihn und stelle ihn hier ein. Benutze dazu bitte den 5. Schalter von rechts in der 2. Iconreihe.
[
Bild bitte so als Datei hochladen: Klick mich!]
Halöchen,
noch ein Hinweis. Wenn Du eine Datei ohne Makros einstellst, dann bitte auch als xlsx. Wenn Du eine xlsm nimmst, dann werden diejenigen, die Bedenken gegen Makros haben, die Datei auch nicht downloaden.
Zu Deiner Anmerkung mit dem "eleganteren Weg" - wenn Du damit einen "eleganteren Code" meinst, möchte ich mich dahingehend den Vorrednern anschließen, dass zum Bewerten das Original nicht schlecht wäre. Aus dem Code kann man auch auf die Abläufe schließen, wenn einem die Erklärung nicht ganz reicht.
Okay, hier habe ich den Code nochmal nachgebaut.
Besonders ärgerlich ist, dass ich die Pivot Tabelle in einem neuen Arbeitsblatt erstellen muss und nicht im vorhandenen Arbeitsblatt erstellen kann, (Zumindest weiß ich nicht wie), ohne dass es zu einem Makro-Abbruch kommt. Dadurch erhalte ich mit jedem erneuten Makro-Durchlauf ein neues fortlaufendes Arbeitsbaltt, das zwar nicht die Funktionsweise stört aber sehr unsauber aussieht.
Wenn Ihr noch weitere Infos benötigt, gerne Bescheid geben.
Code:
Sub ABestellteArtikelKopieren()
'
' BestellteArtikelKopieren Makro
'
'
Columns("A:A").Select
Selection.Copy
Sheets("StrukturstuecklisteRohdatei").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Call BSVERWEISFilterwerteSchaffen
End Sub
Sub BSVERWEISFilterwerteSchaffen()
'
' SVERWEISPruefung Makro
'
'
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-2],R2C1:R5C1,1,FALSE)),""Nicht Relevant"",VLOOKUP(RC[-2],R2C1:R5C1,1,FALSE))"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D22")
Range("D2:D22").Select
Range("A1").Select
Call CPivotErstellenUndKopieren
End Sub
Sub CPivotErstellenUndKopieren()
'
' Makro9 Makro
'
'
Sheets("StrukturstuecklisteRohdatei").Select
Columns("B:D").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"StrukturstuecklisteRohdatei!R1C2:R1048576C4", Version:=xlPivotTableVersion15 _
).CreatePivotTable TableDestination:="", TableName:= _
"PivotTable7", DefaultVersion:=xlPivotTableVersion15
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Erzeugnis")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Komponente")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte").CurrentPage _
= "(All)"
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte")
.PivotItems("Nicht Relevant").Visible = False
.PivotItems("(blank)").Visible = False
End With
ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte"). _
EnableMultiplePageItems = True
Columns("A:A").Select
Selection.Copy
Sheets("Ziel Sollstatus nach Makro").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
End Sub
Hallöchen,
ich gehe jetzt Offline und schaue morgen Abend wieder rein :20:
Hallöchen,
AUfzeichnen ist für den Anfang schon nicht der schlechteste Weg, zumindest erst mal zu einem Grundgerüst zu kommen. Meist funktioniert das auch, manchmal gibt es das eine oder andere, was nicht geht.
Allgemein kann man z.B. schauen, wie man Select's, Scrollaktionen usw. wieder los wird. Das braucht oder macht man vielleicht bei der Aufzeichnung, aber der Code braucht es nicht wirklich.
z.B. diese beiden Zeilen hier
Columns("A:A").Select
Selection.Copy
werden zu
Columns("A:A").Copy
Oder statt
Range("D2:D22").Select
Range("A1").Select
reicht
Range("A1").Select
Hier
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Erzeugnis")
.Orientation = xlRowField
.Position = 1
End With
...
könntest Du etwas sparen
With ActiveSheet.PivotTables("PivotTable7")
With .PivotFields("Filterwerte")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Erzeugnis")
.Orientation = xlRowField
.Position = 1
End With
...
End With
Der Tabellenname in Deinem Code stimmt nicht mit dem Blattname in der Datei überein. Im Bereich B:D fehlen Daten in Spalte C. Für SourceData solltest Du nicht alle Zeilen des Blattes nehmen. Damit das flexibel wird, könntest Du die Daten als Tabelle zusammenfassen. Die passt sich automatisch an, wenn Du Daten hinzufügst und entsprechend wirkt sich das dann auch auf die Pivot aus.
Für die Positionierung auf dem Blatt nimmst Du z.B.
TableDestination:="'Strukturstückliste Rohdatei'!R1C6"
Ich gehe jetzt auch gleich wieder Offline und bin morgen für weitere Fragen bereit :-)
Hallo und danke für deine Erklärung. Wirklich super!
Ich schaue es mir heute Abend genauer an und versuche meinen Code anzupassen.