Office: Spalte A durchlaufen und wenn NICHT Leer, Spalte B kopieren

Hallo zusammen,

nach mehreren Videos und textuellen Lösungsansätzen habe ich noch keine finale Lösung für mich gefunden. Daher ist dies der Weg der Hoffnung für mich.

Ich habe eine Excel-Tabelle bei der im Tabellenblatt "BEARBEITUNG" alle Bewerber- und Kennungsdaten eingetragen werden. Nach der Eintragung erfolgt die Übertragung der Bewerberdaten mittels Spezialfilter in ein neues Tabellenblatt.

Zwei Sachen benötige ich.
1) Löschroutine für "BEARBEITUNG", d. h. in Spalte A wird ein Datum eingetragen, in Spalte B und C stehen die Namen. Diese sollen automatisch gelöscht werden, wenn das Datum in Spalte A älter als 6 Monate zum Dateiöffnungsdatum ist.

2) Im Tabellenblatt "Anhörung" ist in Spalte A ein "x" gesetzt , wenn der Datensatz in einem anderen Programm bearbeitet wurde. Nach Spalte A folgen alle Bewerberdaten, wobei die zu kopierenden nicht ausgeblendet sind. Ich möchte nun VBA sagen, dass er Spalte A durchlaufen soll und solange kein "X" gesetzt und in der Nachbarspalte Inhalte sind, alle sichtbaren Inhalte von B:AL in eine neue Excel-Datei kopiert.

Zweck ist, dass meherer Leute parallel arbeiten können.

Wie müsste hier der Code aussehen? Über Hilfe wäre ich sehr dankbar.

VG Christoph

:)

 

Hallo Christiph,

ich habe dir für Teil1 was geschrieben und schlage vor, für den anderen Teil ein anderes Thema zu eröffnen.
Code:

Ich habe dieses Makro mit der Idee entworfen, dass es möglichst einfach zu verstehen ist. Es ist allerdings "relativ" langsam. Wie lange der Code braucht, um deine Daten zu verarbeiten, hängt von der Menge der Daten ab und wie viel und was für Formeln im Tabellenblatt stehen.
Jetzt müsstest du mal testen, ob es überhaupt so funktioniert, wie du es dir gedacht hast, und ob die Geschwindigkeit in deinem speziellen Fall ausreicht.

Grüße, Ulrich

 

Dem kann man entnehmen, dass du schon eine Lösung hast, nur eben keine finale. Wie sieht diese aus? Welche Vorarbeit hast du geleistet?
Und wo ist die Beispielmappe mit Daten? Denn deine Datei nachbauen mag keiner.

 

Hi Ulrich,

vielen Dank. Sehr verständlich und funktioniert auch fast. *Smilie

Es löscht nun Spalte B, aber nicht auch C und es löscht unabhängig davon, ob das aktuelle Datum mehr als 6 Monate vom Datum in Spalte A zeitlich entfernt ist.

Leider liegt genau beim welche Spalten gelöscht werden müssen und der > 6 Monate Abfrage meine persönliche Lücke. Was muss ich anpassen?

Danke für deine Mühe.

VG Christoph

 

Hallo MisterBurns,

ich habe die Light-Variante mit den zwei Tabellenblättern, um die es geht angehangen. Das meiste konnte ich mit Makro lösen. Ich habe das letzte Mal vor 7 Jahren mit VBA programmiert... da ist einiges versandet.

Ich hoffe, das macht es etwas klarer. *Smilie

VG Christoph

 

Den anderen Teil mit 270 kb bekomme ich leider nicht hochgeladen. Noch mehr eindampfen funktioniert nicht. Daher hier der Code:

PHP:

         Sub Anhörungserstellung()

'es wird eine neue Datei erstellt
Workbooks.Add

'1 in () anpassen, wenn nicht das 1. Tabellenblatt die Quelle ist
With ThisWorkbook.Sheets(9)
'Bereich E2:F75 wird kopiert
.Range("A4:B500").Copy
With Range("A1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
.Range("E4:I500").Copy
With Range("C1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
.Range("K4:K500").Copy
With Range("H1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
.Range("O4:O500").Copy
With Range("I1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
.Range("T4:T500").Copy
With Range("J1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
.Range("W4:AF500").Copy
With Range("K1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
.Range("AK4:AL500").Copy
With Range("U1")
'nur die Werte werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'nur die Formate werden in die neue Datei an gleicher Stelle übertragen
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
'Blatt der neuen Tabelle erhält selben Blattnamen aus Quelldatei
ActiveSheet.Name = "Serienbriefdaten"
'neue Datei wird im selben Verz der Quelldatei mit dem Namen aus B2 aus Quelldatei _gespeichert
'existiert die Datei schon, erfolgt eine Fehlermeldung
ActiveWorkbook.SaveAs "Anhörungserstellung. " & Format(Date, "yyyy-mm-dd") & ".xls"
End With

End Sub


 

Hallo,

Das kann ich nicht nachvollziehen und wenn ich den Code an deiner Beispieldatei "Eintrittsliste Recruiting_Light_Teil2. 2018-04-18.xlsm" teste, dann stimmt deine Aussage auch nicht: es wird Zeile 5 komplett glöscht (weil sie die einzige ist, deren Alter mehr als 6 Monate zurück liegt).

Oh, sorry, ich lösche ganze Zeilen, anstatt nur den Inhalt der Spalten B und C.
Das kann man ändern:
Code:

Teste den code doch mal genauer ;-).

Einzelschritt (im Visualbasiceditor Cursor in das entsprechende Makro setzen und F8 mehrfach drücken) hilft beim Verständnis, insbesondere wenn man gleichzeitig auf der anderen Bildschirmhälfte das Tabellenblatt im Blick hat.

Grüße, Ulrich

[edit: noch ein paar Tipps:
Module kann man löschen: im VisualBasicEditor Rechtsklick im Projekt-Explorer (Strg+R, falls er nicht angezeigt wird) auf das Modul. Dann Klick auf "Entfernen von Modul" => "Nein".
Die grundsätzliche Verwendung von "Option Explicit" hilft: Link zu einem Tutorial.
Zur besseren Übersicht kann man - wenn man viele Module hat - diesen auch einfach einen guten (selbsterklärenden) Namen geben:
Modul im Projekt-Explorer markieren und F4 drücken. Dann im Eigenschaften-Fenster einen Namen eingeben.

 

Hallo Lemk

Löschen von B & C nach Erstellunsdatum der Datei!

Code:

Gruß Michael

 

Hallo Lemk

Der Backlash wird wohl im Forum unterdrückt!
Bei der If Abfrage die ersten "" mit Backlash ergänzen!

Gruß Michael

 

Hallo Michael,

cool. Danke für den Input. Rein nach dem Erstellungsdatum der Datei würde nicht ausreichen, weil die Datei immer weiter bearbeitet wird. Lediglich die Spalten für Vor- und Nachnamen sollen nach 6 Monaten DSGVO-konform anonymisiert werden. *Smilie

 

Teste den code doch mal genauer ;-).

Einzelschritt (im Visualbasiceditor Cursor in das entsprechende Makro setzen und F8 mehrfach drücken) hilft beim Verständnis, insbesondere wenn man gleichzeitig auf der anderen Bildschirmhälfte das Tabellenblatt im Blick hat.

Grüße, Ulrich

[edit: noch ein paar Tipps:
Module kann man löschen: im VisualBasicEditor Rechtsklick im Projekt-Explorer (Strg+R, falls er nicht angezeigt wird) auf das Modul. Dann Klick auf "Entfernen von Modul" => "Nein".
Die grundsätzliche Verwendung von "Option Explicit" hilft: Link zu einem Tutorial.
Zur besseren Übersicht kann man - wenn man viele Module hat - diesen auch einfach einen guten (selbsterklärenden) Namen geben:
Modul im Projekt-Explorer markieren und F4 drücken. Dann im Eigenschaften-Fenster einen Namen eingeben.

Hallo Ulrich,

das funktioniert nun wunderbar im ersten Test. Echt cool! Und für mich absolut nachvollziehbar. Wo müsste ich das Screenupdating im Code platzieren, damit das Sub beim Öffnen der .xlsm ausgeführt wird?

Du hast mir sehr viel Verwirrung genommen. Echt klasse. *Smilie

VG Christoph

 

Hallo,

freut mich, dass das Geschreibsel nicht umsonst war :Smilie: .

Du hast das Makro ja in ein Modul (Allgemeines Modul) kopiert. Damit ist es von überall aus erreichbar. Das ist gut für das automatische ausführen beim öffnen der Datei:

Automatisch ausgeführt wird das Workbook_Open-Ereignis. Damit bei dir was passiert musst du im Modul der Arbeitsmappe ("DieseArbeitsmappe") diesen Code platzieren:
Code:

Das Makro wird natürlich nur ausgeführt, wenn die Sicherheitseinstellungen so getroffen sind, dass Makros ausgeführt werden.

klappt's?
Grüße, Ulrich

 

Hallo Community und Ulrich!

Keine Idee und kein Code wurde jemals umsonst geschrieben!

Der größte Teil der User nutzt die Datenbanksuche in einem Forum *biggrin.gif*

Solche Meinung entspringt also eher einem kontrproduktiven Aberglauben!

Gruß Michael

 

Das Makro wird natürlich nur ausgeführt, wenn die Sicherheitseinstellungen so getroffen sind, dass Makros ausgeführt werden.

klappt's?
Grüße, Ulrich

Hat funktioniert. Nun weiß ich auch wieder, was es mit den Private Subs auf sich hat. Die Erinnerung kommt stetig wieder. *Smilie

Danke!