VBA Anfrage zur Vorbereitung für Pivots

Robexcel · 13. Februar 2010 um 20:13

Liebe VBA Freunde,

ich bräuchte mal Eure Hilfe.

Ich ziehe aus einem System fast täglich Daten, doch bevor ich daraus eine Pivot erstellen kann, muss ich händisch ein paar Anpassungen vornehmen. Was auf Dauer nervt, aber ein Marko könnte hierbei enorm hilfreich sein.

1.) Erzeugen und Ersetzen!
Zu aller erst möchte ich, dass das Marko automatisch die Spalte in dem Datensatz sucht wo im Spaltenkopf „intern/extern“ steht und daneben eine Spalte einfügt und dieses „intern/extern_adj“ nennt.
Nun sollen alle Daten aus „intern/extern“ in die neue Spalte kopiert werden.
Wobei hier alle Datensätze die „ExB“ und „ExR“ heißen durch „extern“ ersetzen soll. Die restlichen sollen einfach kopiert werden.

2.) Leere Spaltenköpfe benennen bzw. kopieren
In meinem Datendownload gibt es auch Spalten ohne Spalten“überschriften“.
Was blöd is beim Erstellen von Pivots.
Folgendes soll gemacht werden, die Spalte ohne Spaltenkopf soll den gleichen Spaltennamen, wie die Spalte davor haben. Also einfach den Spaltennamen kopieren von der Zelle zur Linken!

Da man die Spalten vor dem Download unterschiedlich anordnen kann, können die leeren Zelle mal in Spalte C und G etc. und ein anderes mal in Spalte D und F etc stehen. Das müsste das Makro selbst herausfinden wo sich die leeren Spalteköpfe befinden.

Ausnahme: Es wird nie vorkommen, dass am Anfang und am Ende eine Spalte ohne Spaltenkopfbezeichnung auftauchen wird.

3.) Hinweis & Zusatz-App
Der Datensatz fängt bisher immer in einer bestimmten Zeile an.
Was aber nicht schleccht wäre, wenn ich eine Abfrage erhalte zB.
„In welcher Zeile fängt Dein Datensatz an?“ und dann entsprechend meiner Antwort das Makro dort anfängt. Just in case der Datensatzbeginn ändert sich irgendwann.

4.)Pivot
Es wäre natürlich Klasse wenn das Makro auch gleich automatisch ne Pivot in einem neuen Tabellenblatt erzeugen könnte?!

Ich habe Teil 1 der Übung versucht mittels Marko aufzeichnen, aber sobald dass „intern/extern“ Feld woanders steht kopiert er die falsche Stelle…

Falls jemand Lust und Laune hat, wäre ich Ihnen über eine Lösung bzw. Lösungsvorschläge sehr dankbar.

Anbei hab ich noch ne Beispieldatei.
http://rapidshare.com/files/350192318/Makro_internex…

Reinhard_fb8cb7 · 14. Februar 2010 um 09:47

Ich ziehe aus einem System fast täglich Daten, doch bevor ich
daraus eine Pivot erstellen kann, muss ich händisch ein paar
Anpassungen vornehmen. Was auf Dauer nervt, aber ein Marko
könnte hierbei enorm hilfreich sein.

Hallo Rob,

der nachstehende Code beruht darauf daß er die Zelle mit „intern/extern“ an der richtigen Stelle findet, daraufhin wird alles andere berechnet.
Wenn es nur eine Zelle mit diesm Namen gibt braucht man keine Abfrage.

Zu Pivots, da habe ich keine Ahnung von, sonst hätte ich das gleich miteingebaut.

In Modul1:

Option Explicit
'
Sub tt()
Dim wks As Worksheet, find, Zei As Long, Z As Long, Spa As Long, S As Long
Set wks = Worksheets("Datensatzbsp\_ohne Erkl. Lösung")
On Error GoTo Fehler
With wks
 Set find = .UsedRange.find("intern/extern")
 .Columns(find.Offset(0, 1).Column).Insert
 find.Offset(0, 1).Value = "intern/extern\_adj"
 .Columns(find.Offset(0, 1).Column).AutoFit
 Zei = .Cells(.Rows.Count, find.Column).End(xlUp).Row
 Spa = .Cells(find.Row, Columns.Count).End(xlToLeft).Column
 find.Offset(1, 0).Resize(Zei - find.Row, 1).Copy Destination:=find.Offset(1, 1)
 For Z = find.Offset(0, 1).Row To Zei
 .Cells(Z, find.Offset(0, 1).Column).Value = Replace(.Cells(Z, find.Offset(0, 1).Column).Value, "ExR", "extern")
 .Cells(Z, find.Offset(0, 1).Column).Value = Replace(.Cells(Z, find.Offset(0, 1).Column).Value, "ExB", "extern")
 Next Z
 For S = 2 To Spa
 If Cells(find.Row, S) = "" Then Cells(find.Row, S) = Cells(find.Row, S - 1)
 Next S
End With
Fehler:
If Err.Number 0 Then MsgBox Err.Number & Chr(10) & Err.Description
End Sub

Gruß
Reinhard

Robexcel · 14. Februar 2010 um 11:03

PERFEKT!

Das ist natürlich eine sehr gute Idee von Dir, dass es erst nach intern/extern suchen soll und von dort aus starten, da spart man sich die Abfrage!

Vielen Dank!

Gruß
Robert

Reinhard_fb8cb7 · 14. Februar 2010 um 11:59

Das ist natürlich eine sehr gute Idee von Dir, dass es erst
nach intern/extern suchen soll und von dort aus starten, da
spart man sich die Abfrage!

Hallo Robert,

solange es irgendwas gibt, an dem das Makro selbst erkennen kann wo was beginnt braucht man keine extra Abfrage.

Nimm mal so eine fertige Tabelle, markiere A1.
Dann zeichne ein Makro auf während du dir daraus ein Picot bastetelst.

Zur Not übe das mehrmals nacheinander, immer beginnend mit der fertigen Tabelle und Start bei A1 und immer neues Mako aufzeichnen.

Dann müßte ja am Ende ein Makrocode dastehen, der unterste im Modul2, wo du aus einer fertigenTabelle eine Pivot gebastelt hast ohne viele Umwege,Irrungen usw.

Zeige hier mal diesen Code.

Gruß
Reinhard

Robexcel · 14. Februar 2010 um 16:57

Hi Reinhard,

also habe das Erstellen einer Pivot mal aufgezeichnet.

_Sub pivot_record_v3()
’
’ pivot_record_v3 Makro
’ Makro am 14.02.2010 von richrob aufgezeichnet
’

’
Range(„A1“).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
„query!R1C1:R11C7“).CreatePivotTable TableDestination:="", TableName:= _
„PivotTable3“, DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
End Sub_

Aber wie ich schaffe ich es, falls die Daten in Zeile 3 anfangen, dass automatisch erkennt. Und von dort aus den Zellbereich markiert.

bzw. die Datenmenge variiert ja auch in Anzahl der Spalten und Zeilen.
Das Makro würde ja immer nur auf den einen Zellbereich zugreifen, richtig? --> SourceData:= _
„query!R1C1:R11C7“).CreatePivotTable TableDestination:=""

Könnte man diesen Set find = .UsedRange.find(„intern/extern“) Ausdruck einbauen. Also dort in der Zeile wo sich auch intern/extern befindet soll er nach ganz links gehen und von dort aus alle Daten markieren.

Aber wie geht das!? Kann man das dem MArko beim Aufzeichnen klarmachen!?

Viele Grüße und besten Dank
Robert

Reinhard_fb8cb7 · 14. Februar 2010 um 18:03

Könnte man diesen Set find =
.UsedRange.find(„intern/extern“) Ausdruck einbauen. Also
dort in der Zeile wo sich auch intern/extern befindet soll er
nach ganz links gehen und von dort aus alle Daten markieren.

Aber wie geht das!? Kann man das dem MArko beim Aufzeichnen
klarmachen!?

Hallo Robert,

du hast die Problematik schon sehr gut erkannt.
Das aufgezeicnete Makro ist unflexibel. Deshalb muß man dann den Code umbauen.
Ich konnte diesen Code nicht aufzeichnen weil ich gar nicht weiß wie ich da eine tabelle in eine Pivot umwandle.

Aber ich kann Vba-mäßig den Code den du aufgezeichnet hast versuchen dynamisch zu gestalten.

Aber gib mir Zeit, habs grad eben gelesen was du schriebst

PS: wo sind eigentlich Marion und Thomas? Machen die da einen auf Fasching und ich arme Sau muß mich mit ungeliebten Pivots rumschlagen *sehr motz* ))
(Denk dir nix dabei, ist intern *gg*)

Gruß
Reinhard

Robexcel · 14. Februar 2010 um 19:51

Hallo Reinhard,

jo klar, keine Eile, musste bisher ja auch händisch gehen

Gruß
Robert

Thomas_Ramel · 15. Februar 2010 um 07:54

Grüezi zusammen

…ihr habet gerufen, Meister!..

du hast die Problematik schon sehr gut erkannt.
Das aufgezeicnete Makro ist unflexibel. Deshalb muß man dann
den Code umbauen.
Ich konnte diesen Code nicht aufzeichnen weil ich gar nicht
weiß wie ich da eine tabelle in eine Pivot umwandle.

Aber ich kann Vba-mäßig den Code den du aufgezeichnet hast
versuchen dynamisch zu gestalten.

Aber gib mir Zeit, habs grad eben gelesen was du schriebst

PS: wo sind eigentlich Marion und Thomas? Machen die da einen
auf Fasching und ich arme Sau muß mich mit ungeliebten Pivots
rumschlagen *sehr motz* ))
(Denk dir nix dabei, ist intern *gg*)

Ich bin frisch aus dem Ski-Urlaub zurück und klinke mich hier jetzt ein

Reinhards Code habe ich noch etwas abgewandtelt da es IMO wenig Sinn macht, die ganze Spalte einzeln abzuklappern um zu ersetzen. Alsdann habe ich die Erstellung des Pivot-Caches ebenfalls mit den bereits vorhandenen Objekten automatisiert - ich denke, dass das so klappen sollte.

(Ach ja - gleichlautende Spaltenüberschriften mag die PT auch nicht so sehr, das habe ich ebenfalls angepasst.)

Option Explicit

Sub tr()
Dim wks As Worksheet, find As Range, Zei As Long, Z As Long, Spa As Long, S As Long
 Set wks = ActiveSheet
 On Error GoTo Fehler
 With wks
 Set find = .UsedRange.find("intern/extern")
 .Columns(find.Offset(0, 1).Column).Insert
 find.Offset(0, 1).Value = "intern/extern\_adj"
 .Columns(find.Offset(0, 1).Column).AutoFit
 Zei = .Cells(.Rows.Count, find.Column).End(xlUp).Row
 Spa = .Cells(find.Row, Columns.Count).End(xlToLeft).Column
 find.Offset(1, 0).Resize(Zei - find.Row, 1).Copy Destination:=find.Offset(1, 1)

 With find.Offset(0, 1).EntireColumn
 .Replace "ExR", "extern"
 .Replace "ExB", "extern"
 End With

 With find.EntireRow.SpecialCells(xlCellTypeBlanks)
 .FormulaR1C1 = "=RC[-1]& ""1"""
 .Value = .Value
 End With

 ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, \_
 SourceData:=.Name & "!" & find.CurrentRegion.Address).CreatePivotTable \_
 TableDestination:="", \_
 TableName:="PivotTable3", \_
 DefaultVersion:=xlPivotTableVersion10
 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
 End With
Fehler:
 If Err.Number 0 Then MsgBox Err.Number & Chr(10) & Err.Description
End Sub

–
Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Reinhard_fb8cb7 · 15. Februar 2010 um 13:26

Grüezi Thomas,

…ihr habet gerufen, Meister!..

ich glaube dieser kleine Ricolaschweizer sollte mal die Amis am Saunatuchzipfel ziehen, just in time hat sicher auch ein Schweizer erfunden *lächel*
Kommst genau richtig

PS: wo sind eigentlich Marion und Thomas? Machen die da einen
auf Fasching und ich arme Sau muß mich mit ungeliebten Pivots
rumschlagen *sehr motz* ))
(Denk dir nix dabei, ist intern *gg*)

Ich bin frisch aus dem Ski-Urlaub zurück und klinke mich hier
jetzt ein

wb Das entspannt mich. Ich hab gestern schon befürchtet ich müßte mich ernstlich mit diesen Pivots beschäftigen *gg*

Reinhards Code habe ich noch etwas abgewandtelt da es IMO
wenig Sinn macht, die ganze Spalte einzeln abzuklappern um zu
ersetzen.

Ach, bin immer auf der Arbeitnehmerseite, in der Zeit kann der AN mal entspannen während in XL2007 da 1 Mio Zellen einzeln abgeklapprt werden )
Außerdem fühle ich mich geehrt, daß doch recht viel von meinem Code stehenblieb

Alsdann habe ich die Erstellung des Pivot-Caches
ebenfalls mit den bereits vorhandenen Objekten automatisiert -

Das hätte ich auch probiert und evtl. auch geschafft, naja, 2-X Stunden kann sowas dann schon dauern.
Danke daß du mir diese Zeit erspart hast.

(Ach ja - gleichlautende Spaltenüberschriften mag die PT auch
nicht so sehr, das habe ich ebenfalls angepasst.)

Tztz, schlampig programmiert diese PTs *hihi*

Gruß
Reinhard