19.12.2018, 13:31
19.12.2018, 13:44
Hallo
ich war bisher nicht im Thread, und habe aus Neugier und Interesse eine höfliche Frage: ist diese Aufgabe ungelöst??
Ich sehe eine Makro Lösung von Profi snb, mit einem Danke, eine von Fennek. Aber irgenwie habe ich das Gefühl es klappt immer noch nicht??
Liege ich da richtig?
mfg Gast 123
ich war bisher nicht im Thread, und habe aus Neugier und Interesse eine höfliche Frage: ist diese Aufgabe ungelöst??
Ich sehe eine Makro Lösung von Profi snb, mit einem Danke, eine von Fennek. Aber irgenwie habe ich das Gefühl es klappt immer noch nicht??
Liege ich da richtig?
mfg Gast 123
19.12.2018, 14:21
Hallo Patrick,
stimmt der Code ist von mir und ich habe die Datenquelle gefunden. Diepasst aber nicht mit den Matrikel-Nummern zusammen.
Deshalb hier ungegrüft mit dem Code von snb ergänzt:
mfg
(Der Ansatz mit "Selected Cell" war damals gedacht, um einzelne Zeilen nachträglich zu bearbeiten)
stimmt der Code ist von mir und ich habe die Datenquelle gefunden. Diepasst aber nicht mit den Matrikel-Nummern zusammen.
Deshalb hier ungegrüft mit dem Code von snb ergänzt:
Code:
Sub Etudes_hinzufuegen()
Dim WBQ As Workbook
Dim WSZ As Worksheet: Set WSZ = ActiveSheet
Dim WSQ As Worksheet
Pfad = ThisWorkbook.Path & "\"
If Pfad <> "" Then
'automatische Öffnen
sF = Pfad & "AAAA_Matricules_Etudes Avocats.xlsx" 'Filenamen
'Auswahl der Datei
'sF = Application.GetOpenFilename("xlsx-Dateien (*.xlsx),*.xlsx", MultiSelect:=False)
End If
'Set WBQ = Workbooks.Open(sF)
Set WBQ = GetObject(sF)
Set WSQ = WBQ.Sheets(1)
With WSZ
i = 2
Do While .Cells(i, 2) <> ""
'beim 2.Lauf nicht doppelt
If .Cells(i, 3) = "" Then
Set Rng = WSQ.UsedRange.Find(WSZ.Cells(i, 2), , xlValues, xlWhole)
If Not Rng Is Nothing Then
'.Cells(i, 2) = WSQ.Cells(Rng.Row, 2) 'ID aus Spalte B
.Cells(i, 3) = WSQ.Cells(Rng.Row, 6) 'Vorname: F
.Cells(i, 4) = WSQ.Cells(Rng.Row, 5) 'Nachname: E
'Firma, falls kein Name
If IsEmpty(.Cells(i, 3)) And IsEmpty(.Cells(i, 4)) Then .Cells(i, 3) = WSQ.Cells(Rng.Row, 1)
.Cells(i, 6) = WSQ.Cells(Rng.Row, 10) 'Straße: J
.Cells(i, 7) = WSQ.Cells(Rng.Row, 9) 'Hausnummer: I
.Cells(i, 8) = WSQ.Cells(Rng.Row, 11) 'Boîte Postale: K
.Cells(i, 10) = WSQ.Cells(Rng.Row, 12) 'Postleitzahl: L
.Cells(i, 9) = WSQ.Cells(Rng.Row, 15) ' Land: O
.Cells(i, 11) = WSQ.Cells(Rng.Row, 13) 'Ortschaft: M
.Cells(i, 12) = WSQ.Cells(Rng.Row, 14) 'Kanton: N
Else
.Cells(i, 3) = "Pas de données" 'falls ID in der Datenbank nicht vorhanden
End If
End If
'wie Makro 1 <<<<<<<<<<<<<<<<<<<<< ungeprüft >>>>>>>>>>>>>>>>>>>>>>
If InStr(.cells(i, 17), "-") Then .Cells(i, 17) = Split(.cells(i, 17), "-")(2)
i = i + 1
Loop
End With
WBQ.Close 0
End Sub
mfg
(Der Ansatz mit "Selected Cell" war damals gedacht, um einzelne Zeilen nachträglich zu bearbeiten)
19.12.2018, 15:17
Vielen dank werde mal ausprobieren
19.12.2018, 15:40
Code:
Sub Etudes_hinzufuegen()
Dim WBQ As Workbook
Dim WSZ As Worksheet: Set WSZ = ActiveSheet
Dim WSQ As Worksheet
Pfad = ThisWorkbook.Path & "C:\Users\kargp\Desktop\"
If Pfad <> "" Then
'automatische Öffnen
sF = Pfad & "Tabelle1.xlsx" 'Filenamen
'Auswahl der Datei
'sF = Application.GetOpenFilename("xlsx-Dateien (*.xlsx),*.xlsx", MultiSelect:=False)
End If
'Set WBQ = Workbooks.Open(sF)
Set WBQ = GetObject(sF)
Set WSQ = WBQ.Sheets(1)
With WSZ
i = 2
Do While .Cells(i, 2) <> ""
'beim 2.Lauf nicht doppelt
If .Cells(i, 3) = "" Then
Set Rng = WSQ.UsedRange.Find(WSZ.Cells(i, 2), , xlValues, xlWhole)
If Not Rng Is Nothing Then
'.Cells(i, 2) = WSQ.Cells(Rng.Row, 2) 'ID aus Spalte B
.Cells(i, 3) = WSQ.Cells(Rng.Row, 6) 'Vorname: F
.Cells(i, 4) = WSQ.Cells(Rng.Row, 5) 'Nachname: E
'Firma, falls kein Name
If IsEmpty(.Cells(i, 3)) And IsEmpty(.Cells(i, 4)) Then .Cells(i, 3) = WSQ.Cells(Rng.Row, 1)
.Cells(i, 6) = WSQ.Cells(Rng.Row, 10) 'Straße: J
.Cells(i, 7) = WSQ.Cells(Rng.Row, 9) 'Hausnummer: I
.Cells(i, 8) = WSQ.Cells(Rng.Row, 11) 'Boîte Postale: K
.Cells(i, 10) = WSQ.Cells(Rng.Row, 12) 'Postleitzahl: L
.Cells(i, 9) = WSQ.Cells(Rng.Row, 15) ' Land: O
.Cells(i, 11) = WSQ.Cells(Rng.Row, 13) 'Ortschaft: M
.Cells(i, 12) = WSQ.Cells(Rng.Row, 14) 'Kanton: N
Else
.Cells(i, 3) = "Pas de données" 'falls ID in der Datenbank nicht vorhanden
End If
End If
'wie Makro 1 <<<<<<<<<<<<<<<<<<<<< ungeprüft >>>>>>>>>>>>>>>>>>>>>>
If InStr(.Cells(i, 17), "-") Then .Cells(i, 17) = Split(.Cells(i, 17), "-")(2)
i = i + 1
Loop
End With
WBQ.Close 0
End Sub
Jetzt sagt er mir "Datei- oder Klassenname während Automatisierungsoperation nicht gefunden" doch der Pfad zur Datei stimmt
19.12.2018, 16:21
Hallo,
es geht nur eins von beiden:
mfg
es geht nur eins von beiden:
Code:
Pfad = ThisWorkbook.Path & "C:\Users\kargp\Desktop\"
mfg
03.03.2019, 17:46
Hallo Fennek,
Könntest du mir hier in diesem VBA noch hinzufügen dass wenn die Daten nicht gefunden werden also "pas de données" dass er die Zeilen zusätzlich noch einfärbt so dass man es besser sieht.
Resp. auch dass sich ein Fenster öffnet mit der Anzahl nicht gefundenen Daten. Aber so dass ich im VBA diese Option ein und ausschalten kann.
Vielen lieben dank
Könntest du mir hier in diesem VBA noch hinzufügen dass wenn die Daten nicht gefunden werden also "pas de données" dass er die Zeilen zusätzlich noch einfärbt so dass man es besser sieht.
Resp. auch dass sich ein Fenster öffnet mit der Anzahl nicht gefundenen Daten. Aber so dass ich im VBA diese Option ein und ausschalten kann.
Vielen lieben dank
03.03.2019, 17:59
Oder kann mir hier vielleicht ein anderer auf die schnelle weiter helfen um die Zeilen im Vba anzupassen
08.03.2019, 06:43
Hallöchen,
ich kann mir nicht vorstellen, dass so was passt:
Pfad = ThisWorkbook.Path & "C:\Users\kargp\Desktop\"
Pfad könnte dann z.B. so aussehen:
C:\TestC:\Users\kargp\Desktop\
Da könntest Du mal das EInfärben einer Zelle aufzeichnen und den Code entsprechend erweitern.
Du bekommst dann in etwa so etwas:
Du schaust im aufgezeichneten Code, wo die Farbe geändert wird. Das ist die Stelle mit .Color Allerdings ist hier noch etwas mehr relevant. In der Zeile mit With steht noch Selection.Interior. Selection wäre dein cells(i, 3). Interior wäre die Beschreibung, was gefärbt wird. Könnte ja auch die Schrift oder ein Rahmen sein.
Füge also in Deinem Code eine Zeile ein, beginnend mit
.Cells(i, 3).Interior.Color = …
und statt der Punkte Deine Farbe.
ich kann mir nicht vorstellen, dass so was passt:
Pfad = ThisWorkbook.Path & "C:\Users\kargp\Desktop\"
Pfad könnte dann z.B. so aussehen:
C:\TestC:\Users\kargp\Desktop\
Zitat:Könntest du mir hier in diesem VBA noch hinzufügen dass wenn die Daten nicht gefunden werden also "pas de données" dass er die Zeilen zusätzlich noch einfärbt so dass man es besser sieht.
Da könntest Du mal das EInfärben einer Zelle aufzeichnen und den Code entsprechend erweitern.
Du bekommst dann in etwa so etwas:
Code:
Sub Makro1()
'
' Makro1 Makro
'
'
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Du schaust im aufgezeichneten Code, wo die Farbe geändert wird. Das ist die Stelle mit .Color Allerdings ist hier noch etwas mehr relevant. In der Zeile mit With steht noch Selection.Interior. Selection wäre dein cells(i, 3). Interior wäre die Beschreibung, was gefärbt wird. Könnte ja auch die Schrift oder ein Rahmen sein.
Füge also in Deinem Code eine Zeile ein, beginnend mit
.Cells(i, 3).Interior.Color = …
und statt der Punkte Deine Farbe.
08.03.2019, 08:49
Hallo,
Vielen lieben dank für deine Hilfe das klappt auch doch leider beim zweiten durchlauf des VBA Scripts werden die Felder jetzt nicht mehr weiss fals die ID vorhanden ist?
Mfg
Vielen lieben dank für deine Hilfe das klappt auch doch leider beim zweiten durchlauf des VBA Scripts werden die Felder jetzt nicht mehr weiss fals die ID vorhanden ist?
Mfg