AW: Makro: Wenn best. Text enthalten,kop. in Reiter
26.08.2015 11:43:56
Matthias
Hall Braun,
Zeile überschreiben: Jupp, das war mein Versäumnis. Da fehlte eine Zeile in der Schleife welche die letzte Zeile hochzählt.
Zum Problem mit deiner Variablen: Entweder hast du dich verschrieben, oder nicht den richtigen Namen genutzt.
Es gibt 3 Möglichkeiten ein Tabellenblatt anzusprechen.
1. über den Tabellenname
Sheets("Verwaltung")
2. über die Index-Nummer
Sheets(1)
3. über den Code-Namen
Tabelle1
Problem am Tabellenname: Benennst du deine Tabelle um, ist die Funktionsfähigkeit deines Makros nicht mehr gewährleistet, du musst dann den Namen im Code ändern.
Problem Index: Der Index richtet sich nach der Reihenfolge deiner Tabellenblätter, verschiebst du dein erstes Blatt in seiner Position, ist ein anderes die Index-Nummer 1 und wiederum ist das Makro nicht mehr tauglich.
Darum verwendet man den Code-Namen. Dieser ist in der normalen Excel-Umgebung nicht zu sehen und kann daher auch nur von Eingeweihten geändert werden. Egal wie ein Nutzer deine Tabelle umbenennt, der Code-Name bleibt bestehen.
Zur Erklärung des Code-Namens: Wenn du dir folgenden Link anschaust, wirst du merken dass du in deiner VBA-Umgebung links oben ein ähnliches Bild vorfindest (wenn nicht Projekt-Explorer mit Strg+R öffnen):
http://www.administrator.de/images/content/2dedddc54a602178e5f81c50cae8f7f4.png
Code-Name = Tabelle1 (steht vor der Klammer, darf keine Leerzeichen enthalten)
Tabellenname = Verwaltung (in der Klammer)
Für deine Suche nach deinem Suchbegriff "FR" habe ich einfach nur eine ODER-Bedingung eingebaut und fertig ist der Salat.
Option Explicit
Sub Kopieren()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim rZelle As Range
Dim sSuchbegriff As String, sSuchbegriff2 As String, sSuchbegriff3 As String
Dim firstAddress As String
Dim lZeileZ As Long
Application.ScreenUpdating = False
Application.Calculation = xlManual
' -- Bezüge --
Set wksQuelle = Tabelle1
Set wksZiel = Tabelle2 ' "Filter"
sSuchbegriff = "bcd"
sSuchbegriff2 = "GER"
sSuchbegriff3 = "FR"
' erste freie Zeile in Zieltabelle bestimmen
With wksZiel
If .Range("A1").Value = "" Then
lZeileZ = 1
Else: lZeileZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
End With
' Suchbegriff in Spalte C suchen
With wksQuelle
Set rZelle = .Range("C:C").Find(sSuchbegriff, LookIn:=xlValues, LookAt:=xlPart, _
MatchCase:=True)
If Not rZelle Is Nothing Then
firstAddress = rZelle.Address ' ersten Fundort merken
Do
' Check ob Spalte G den Suchbegriff 2 enthält
If (sSuchbegriff2 = .Range("G" & rZelle.Row).Text) Or _
(sSuchbegriff3 = .Range("G" & rZelle.Row).Text) Then
.Rows(rZelle.Row).Copy Destination:=wksZiel.Rows(lZeileZ) ' kopiere Zeile
lZeileZ = lZeileZ + 1
End If
Set rZelle = .Range("C:C").FindNext(rZelle) ' nächster Fundort für Suchbegriff
' Schleife beenden wenn akt. Fundort = erster Fundort
Loop While Not rZelle Is Nothing And rZelle.Address firstAddress
' Fehlermeldung falls der Suchbegriff nicht existiert
Else: MsgBox "Der Suchbegriff " & sSuchbegriff & " konnte nicht gefunden werden."
End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
lg Matthias
