Suchen und Kopieren (2)

Intermezzo

Ein kleines Zwischenspiel, einige kleine Ergänzungen zum ersten Teil. Die Datenbasis und auch die bisher erarbeitete Makros bleiben bestehen, nur Kleinigkeiten werden angepasst.

Basis schaffen

Um die Schritte sinnvoll durcharbeiten zu können, muss erst einmal eine solide Basis geschaffen werden. Grundvoraussetzung: Sie haben die bekannte Tabelle mit den Quell-Daten vorliegen. Erforderlichenfalls laden Sie diese hier noch einmal herunter und fügen Sie den Code aus dieser gepackten Datei ein. Falls noch nicht vorhanden, fügen Sie in der ersten Tabelle (Suchen&Kopieren) eine Zeile mit den Überschriften ein. Die zweite Tabelle mit dem Namen Ziel kann, muss aber nicht vorhanden sein.

▲ nach oben …

Drum prüfe, wer sich ewig bindet …

Wie eben schon erwähnt, eine Tabelle mit dem Namen Ziel muss nicht existieren. Zumindest nicht im jetzigen Stadium, denn natürlich sollen die Daten in ein bestimmtes Blatt kopiert werden. Und das Sheet darf auch den definierten Namen Ziel haben, aber im Hinblick auf künftige Beiträge ist das nicht unbedingt Pflicht. Hier besteht erst einmal Konsens, dass es der Name Ziel sein wird. Also muss erst einmal geprüft werden, ob das entsprechende Arbeitsblatt überhaupt in der aktuellen Mappe existiert. Und falls das nicht der Fall ist, muss es angelegt werden. Das geschieht mit beispielsweise solch einer Routine:

Dim ZeSrc As Integer, ZeDst As Integer
Dim i As Integer, ZielOK As Boolean, ZielName As String

ZielName = "Ziel"
With ThisWorkbook
   For i = 1 To .Sheets.Count
      If .Sheets(i).Name = ZielName Then
         ZielOK = True
         Exit For
      End If
   Next i
   If Not ZielOK Then
      .Sheets.Add After:=.Worksheets(Worksheets.Count)
      ActiveSheet.Name = ZielName
   End If
End With

Set rngSuch = Sheets("Suchen&Kopieren").Range("A:A")
Set wksDst = Sheets(ZielName)
With wksDst

Einige erklärende Worte sind dennoch erforderlich. Die grauen Zeilen sind der bisherige, unveränderte Code. Alles andere wurde neu eingefügt oder geändert. Der Sicherheit wegen habe ich mit dem Schlüsselbegriff ThisWorkbook ausgeschlossen, dass vielleicht auf eine andere geöffnete Arbeitsmappe zugegriffen wird. Und ich habe den Namen der Ziel-Tabelle in eine Variable eingefügt, um diesen bei Bedarf einfach nur an einer einzigen Stelle ändern zu können. Zum testen können Sie gerne die zweite Tabelle löschen und die Sub FindAndCopy2b aufrufen. Und wenn das Blatt bereits existiert, werden natürlich keine Daten darin gelöscht. Diesen Stand der Dinge in Sachen Code können Sie hier herunter laden.

Hinweis: Das Makro Sub ErgebnisLoeschen() ist immer dann doppelt vorhanden, wenn Sie die vorherige Datei weiter verwenden und nicht bein „Stand Null“ gestartet sind. Eine der beiden Prozeduren muss gelöscht werden, es kommt sonst zu einer Fehlermeldung.

▲ nach oben …

Mit Start-Button

Das Makro immer mit beispielsweise AltF8 aufzurufen ist nicht wirklich komfortabel. Da bietet sich eine Schaltfläche doch förmlich an. Und bei der Gelegenheit vielleicht auch gleich fürs löschen 😎 . Wechseln Sie dazu in das Menü Entwicklertools. Wenn diese bei Ihnen nicht sichtbar sind, dann schauen Sie in diesem Beitrag nach, da ist vieles erklärt. Nun klicken Sie auf die Schaltfläche Einfügen und danach zweckmäßigerweise auf  das Button-Symbol bei den Formular-Steuerelementen. Der Rest ist aus unserer Sicht selbsterklärend. Und im Ziel-Datenblatt können Sie gleichermaßen vorgehen.

▲ nach oben …

Ohne InputBox

Die InputBox ist ja eine recht einfache Möglichkeit, Eingaben abzufragen. Aber diese aufploppenden Fenster sind nicht jedermanns Sache. Es gibt ja auch die Möglichkeit, den Suchbegriff in eine Zelle zu schreiben und dann mit dem Button den Such- und Kopiervorgang aufzurufen.

Gesagt, getan. Wir haben in E4 den Text Suchbegriff: geschrieben und in F4 soll dieser dann hineingeschrieben werden. Das Ganze stellt sich so dar:

Hier wird der Suchbegriff eingegeben

Hier wird der Suchbegriff eingegeben

Ach ja, falls Sie in der obigen Abbildung die Farbgebung bzw. die Aufklapppfeile irritieren oder neugierig gemacht haben: Der besseren Übersicht halber und auch aus verschiedenen anderen Gründen arbeiten wir wo immer es geht mit Intelligenten Listen. Die Vorteile sind enorm! Im VBA-Code allerdings nutzen wir hier nicht die Vorteile, die daraus möglich wären. Die Kompatibilität zu älteren Excel-Versionen soll erhalten bleiben.

Vorgesehen ist nun folgendes: Nach einem Klick auf die Schaltfläche soll geprüft werden, ob in F4 etwas drin steht. Fall das so ist, läuft der Rest des bekannten Makros ab und der eben eingegebene Inhalt wird wieder gelöscht, damit bei einem versehentlichen Klick auf die Schaltfläche das Makro mit den zuletzt eingegebenen Werten noch einmal ausgeführt wird. Vorerst werden Sie diesen Code an den vorhandenen anhängen. Das ist möglich, weil sich der Name des Makros von den anderen unterscheidet. – Die Änderungen sind alle in der oberen Hälfte, bitte vergleichen Sie selber.

Anschließend müssen Sie unbedingt der Schaltfläche diese neue Prozedur zuweisen. Dazu bei gedrückter Taste Strg ein Klick auf den Button, welcher sich danach deutlich sichtbar im Editiermodus befindet. Nun darauf zeigen, Rechtsklick und im Kontextmenü den Punkt Makro zuweisen… anklicken. Unter Umständen müssen Sie das öfter einmal versuchen, das ist etwas „frickelig“. Jetzt nur noch das eben eingefügte Makro auswählen und fertig ist der Vorgang.

▲ nach oben …

Suchbereich eingrenzen

Eigentlich ist es eine enorme Ressourcen-Verschwendung, wenn über eine Millionen Zellen durchsucht werden sollen, aber nur knapp über 600 Zellen (in Spalte A) Daten enthalten. Das soll in diesem letzten Schritt des Intermezzos bereinigt werden.

Diese beiden Schritte sind erforderlich, un das Ziel zu erreichen: 

  • Feststellen, welches die letzte Zeile mit Daten ist
  • Den zu durchsuchenden Bereich der Variablen rngSuch zuordnen

Die letzte belegte Zeile der Spalte A finden Sie mit der gleichen Routine, die Sie zum Erkennen der ersten freien Zeile in der Ziel-Tabelle nutzen. Nur dass hier nicht noch 1 addiert wird. Und die Festlegung des Bereichs ähnelt der bisherigen sehr:

Set wksSrc = Sheets("Suchen&Kopieren")
With wksSrc
   lRow = .Cells(Rows.Count, 1).End(xlUp).Row
   Set rngSuch = .Range("A:A")
   Set rngSuch = .Range("A1:A" & lRow)
End With
Set wksDst = Sheets(ZielName)

Zum Abschluss dieser Runde können Sie die aktuelle Version des Codes noch einmal herunter laden, zumindest das Haupt-Makro. Wie immer, natürlich als *.zip gepackt.

Mehr zum Thema:
Suchen und Kopieren (1)
Suchen und Kopieren (2)
Suchen und Kopieren (3)
Suchen und Kopieren (4)
Suchen und Kopieren (5)

▲ nach oben …

Dieser Beitrag wurde unter Mit VBA/Makro, Musterlösungen, Tabelle und Zelle abgelegt und mit , , , , , verschlagwortet. Setze ein Lesezeichen auf den Permalink.