06.03.2021, 22:14 (Dieser Beitrag wurde zuletzt bearbeitet: 06.03.2021, 22:25 von ImC.)
Vielen DANK lieber PivPQ,
magst mir mal auf die Sprünge helfen?
Da dies eine Beispieldatei ist, was kopiere ich in die echte Datei?
Wo finde ich was du gemacht hast?
Das ist wahrscheinlich auch hilfreich für die Ids. Alle Ids_ in die Ids_Gesamt kopieren.
Das ist wie ich es sehe auch so angelegt.
Habe ein Register mit 10090 dazu, aktualisieren macht er nicht.
Fehlermeldung: Initialisierung der Datenquelle schlug fehl. Findet die DB nicht.
06.03.2021, 22:25 (Dieser Beitrag wurde zuletzt bearbeitet: 06.03.2021, 22:49 von PIVPQ.)
Hallo
Ich habe erst jetzt gerade gesehen das du Excel 2007 angegeben hast. Stimmt das, oder ist dein Excel neuer??
Oder hast du ein Mac?
Falls das es stimmt wird meine PQ Version nicht bei dir laufen, deshalb auch die Fehlermeldung.
Hallo
Was du machen musst:
Schritt 1: Befülle die Tabellen mit deinen Originaldaten:
TN_Name Spalte A von ab Zeile 5 bis Spalte G nach unten.
TN_Adr_10040 Spalte A von ab Zeile 6 bis Spalte M nach unten
TN_Adr_10070 Spalte A von ab Zeile 6 bis Spalte M nach unten
TN_Adr_10080 Spalte A von ab Zeile 6 bis Spalte M nach unten
ids_10040 Spalte A von ab Zeile 6 bis Spalte D nach unten
ids_10070 Spalte A von ab Zeile 6 bis Spalte D nach unten
ids_10080 Spalte A von ab Zeile 6 bis Spalte D nach unten
Schritt 2
Rechtsklick in Tabelle TN_Name in Zelle I 4 und auf Aktualisieren klicken. Rechtsklick in Tabelle IDS_Gesamt in Zelle A 4 und auf Aktualisieren klicken.
Mehr ist nicht zu tun. Die einzelnen Schritte was ich gemacht habe kannst du alle im PQ Editor auf der rechten Seite und im erweiterten PQ Editor nachlesen. Hoffe es ist halbwegs verständlich.
Ex 2010, hab Power Quiry jetzt installiert.
Das ist ja genial. Wie eine DB Anwendung.
Fehlermeldung ist weg.
Es geht hier nicht darum die bestehenden Blätter manuell aufzufüllen, sondern das soll Excel machen.
Wo es manuell geht, wo Daten zur Verfügung stehen ist in TN_Name,
Das geht: "diese Tabelle befüllen von A 5 bis G, anschließend rechtsklick in Zelle I 4 und Aktualisieren."
Die Daten die für aktualisieren verwendet werden, sind allerdings in ca. 80 Registerkarten mit den Namen: TN_Adr_ dann die KdNr.
Diese Blätter kommen dann natürlich noch dazu.
Können diese Blätter bei der PowerQuery einfach angefügt werden oder ist dann jeweils von neuem zu beginnen?
Es geht darum aus den TN_Adr_ Blättern die Daten in TN_Namen zu kopieren. Alle KdNr. sind in TN_Name zur Verfügung. Danach kann in sämtlichen TN_Adr. gesucht werden und die restlichen Daten ab Spalte I eingefügt werden. Das soll durch aktualisieren geschehen, so hab ich das verstanden.
Für Ids_Gesamt auch so: es gibt viele Registerkarten mit Namen Ids_ Kdnr., Letztendlich geht es darum was in Blättern die mit Ids_ beginnen in die Ids_Gesamt zu kopieren.
Die Ids_10090 wurde hinzugefügt, aktualisieren. Hat er nicht erkannt. Ist dieses Blatt bei der Query hinzuzufügen oder ist es so gemacht, dass alle Ids_ gefunden werden?
@Fennek schöner Code, klein aber fein, von einem Fachmann. Ich habe mir erlaubt ihn um eine Spalte zu verlaengern (Ansprechpartner Dietmar fehlte) und für die zweite Aufgabe zı kopieren und umszuscheeiben. Für die Ids gesamt Auflistung. Beide Makros funktionieren bei mir einwandfrei. Schöne Arbeit, hat mir gefallen und ich habe bei Split was dazu gelernt. Das abschneiden mit (2) kannte ich noch micht! Gibt es da noch mehr Tricks??
08.03.2021, 13:26 (Dieser Beitrag wurde zuletzt bearbeitet: 08.03.2021, 13:29 von Gast 123.)
Hallo Claudia
freut mich das dir unsere gemeinsame Forum Arbeit gefaellt. Erinnere höflich daran dass der Original Code von Fennek stammt.
Ich habe mir nur erlaubt ihn zu erweitern und für die Ids Auswertung ein zweites Makro zu schreiben. Wie kommt der Code in deine Datei??
Du musst die Datei nach dem Einfügen der Module als xlsm Datei speichern!! Dabei bleibt dir das Original als xlsx erhalten. Die solltest du zur Sicherheit auch bitte nicht löschen Am einfachsten startest du den Makrorecorder zum aufzeichnen und gibt in eine Zelle irgendwas ein. Egal was. Dann hast du schon ein neues Modulblatt im VBA Editor. Den kannst du öffen indem du auf den Makro Dialog gehst, und das neue Makro zum Bearbeiten anklickst.
Dann kopierst du beide Button im Beispiel, fügst sie mit Contrl V in deine Datei ein, und weisst ihnen mit der rechten Maustaste das Makro der Originaldatei zu. Die Makro Endung "TN" oder "Ids" sagt dir wofür dieses Makro bestimmt ist. Das ist alles. Ich bin gespannt wie es im Original funktioniert?
Anbei noch mal der kommentierte Code zum kopieren und VBA lernen. Man braucht aber schon gutes VBA Wissen um ihn zu verstehen.
mfg Gast 123
Code:
'Original Code von Fennek - ergaenzt von Gast 123
Sub F_en_TN()
Dim Sht As Worksheet
Dim RNG As Range
Dim ZL As Range, f As Long
Dim TN As Worksheet
Set TN = Sheets("TN_Name")
On Error Resume Next
For Each Sht In Sheets
'Prüfe den Tabellen Namen auf "TN_Adr"
If InStr(Sht.Name, "TN_Adr") > 0 Then
kd = Split(Sht.Name, "_")(2) 'vorspann Text abschneiden
Set RNG = Sht.Columns(1).Find(kd, , xlValues, xlWhole)
If Not RNG Is Nothing Then
'setze den Bereich von Spalte C bis Spalte M
Set RNG = Sht.Range(RNG.Offset(, 3), RNG.Offset(, 12))
'suche die Kunden Nr. in "TN:Name" Blatt
Set ZL = TN.Columns(1).Find(kd, , xlValues, xlWhole)
'wenn gefunden Daten in die passnde Zeile einfügen
If Not ZL Is Nothing Then RNG.Copy ZL.Offset(, 8)
End If
'von mir eingefügter Code zur Fehlerprüfung
'** (Resume Next zeigt keine Laufzeitfehler an!)
If Err > 0 Then Err.Clear: f = f + 1
End If
Next Sht
Set TN = Nothing
If f > 0 Then MsgBox f & " Fehler aufgeteten!"
End Sub
'kopierter Code von Fennek - zur Ids Auswertung
Sub F_en_Ids()
Dim Sht As Worksheet
Dim RNG As Range
Dim ZL As Range
Dim lz1 As Long, f As Long
Dim IDS As Worksheet
Set IDS = Sheets("Ids_Gesamt")
On Error Resume Next
For Each Sht In Sheets
'Prüfe den Tabellen Namen auf "Ids_"
If InStr(Sht.Name, "Ids_") > 0 Then
kd = Split(Sht.Name, "_")(1) 'vorspann Text abschneiden
Set RNG = Sht.Columns(1).Find("KdNr.", , xlValues, xlWhole)
If Not RNG Is Nothing Then
'setze den Bereich von Spalte A bis D mit LastZell !!
lz1 = Sht.Cells(Rows.Count, 1).End(xlUp).Row
Set RNG = Sht.Range(RNG.Offset(1, 0), RNG.Offset(lz1, 3))
'kopiere Bereich und haenge ihn in "Ids gesamt" unten an
RNG.Copy IDS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
'von mir eingefügter Code zur Fehlerprüfung
If Err > 0 Then Err.Clear: f = f + 1
End If
Next Sht
Set IDS = Nothing
If f > 0 Then MsgBox f & " Fehler aufgeteten!"
End Sub
Nachtrag: Makro recorder abschalten bitte nicht vergessen, und den Text "Makro1" löschst du einfach weg.
Lieber Gast 123,
ja für Fennek natürlich auch ein HERZliches DANKe schön
Bei EDV wirken mehrere. Wie in der Natur, für einen Apfel Bedarf es Sonne, wie Wind, Wasser und anderes . Jedes hat seine Qualität.
Vielen DANK für die Erklärungen. Das werde ich sehen wie das im Original geht.
Zunächst teste ich noch in der Beispieldatei TN-1.
Da ist folgendes aufgefallen:
1. bzgl. Ids:
- die DS erscheinen 2x, werden also in Ids_Gesamt 2x kopiert. Sorry das habe ich jetzt erst gesehen. Vor lauter Euphorie Es sollte natürlich eine Id und nur 1x darin erscheinen.
- gut ist, dass auch aus Registern mit Ids_99999 , das sind welche wo mehrere und somit unterschiedliche KdNr. drin stehen, die Datensätze geholt werden.
2. bzgl. Adr_TN: wenn dies noch zusätzlich geht, wäre fein.
wäre schön, wenn er aus den Registern Adr_TN_99999_* (Stern für z.B. 01, 02 oder den Anprechpartner: Detlev also z.B. Adr_TN_99999_Detlev) alle Datensätze kopiert
Das sind Register wo unterschiedliche KdNr. drin stehen, somit mehrere Datensätze
ich habe mir die Ids Daten mal nach KdNr. sortiert. Dabei fiel mir auf das es verschiedene Vertrags Nr. gibt und das Datum wann bezahlt wurde verschieden ist. Der neue Code s.u. sortiert dir die Ids Daten nach Kunden Nr. und löscht alle Duplikate heraus. Ich hoffe das bringt dich weiter. Würde mich freuen wenn damit alles optimal laeuft.
mfg Gast 123
Code:
Sub F_en_Ids()
Dim Sht As Worksheet
Dim RNG As Range
Dim ZL As Range
Dim lz1 As Long, f As Long
Dim IDS As Worksheet
Set IDS = Sheets("Ids_Gesamt")
On Error Resume Next
For Each Sht In Sheets
'Prüfe den Tabellen Namen auf "Ids_"
If InStr(Sht.Name, "Ids_") > 0 Then
kd = Split(Sht.Name, "_")(1) 'vorspann Text abschneiden
Set RNG = Sht.Columns(1).Find("KdNr.", , xlValues, xlWhole)
If Not RNG Is Nothing Then
'setze den Bereich von Spalte A bis D mit LastZell !!
lz1 = Sht.Cells(Rows.Count, 1).End(xlUp).Row
Set RNG = Sht.Range(RNG.Offset(1, 0), RNG.Offset(lz1, 3))
'kopiere Bereich und haenge ihn in "Ids gesamt" unten an
RNG.Copy IDS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
'von mir eingefügter Code zur Fehlerprüfung
If Err > 0 Then Err.Clear: f = f + 1
End If
Next Sht
With IDS 'sortiert Spalte A, danach Spalte B
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A6:D" & lz1).Sort Key1:=.Range("A6"), Order1:=xlAscending, _
Key2:=.Range("B6"), Order2:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'doppelte Daten löschen
.Range("A6:D" & lz1).RemoveDuplicates Columns:=4, Header:=xlNo
End With
Set IDS = Nothing
If f > 0 Then MsgBox f & " Fehler aufgeteten!"
End Sub
