Makro: Wenn best. Text enthalten,kop. in Reiter

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Makro: Wenn best. Text enthalten,kop. in Reiter
von: braun
Geschrieben am: 25.08.2015 18:29:38

Guten Abend,
ich hätte gerne ein Makro , dass zb den Wortteil "bcd" in Spalte C sucht UND gleichzeitig den wert "GER" in Spalte F in der gleichen Zeile sucht. Wenn diese Werte beide in einer Zeile vorhanden sind, soll es die komplette Zeile kopieren und in Tabelle 2 einfügen, die dann zb "Filter" heißt.
Ich habe das Makro bereits angefangen, nur leider nicht auf diesem PC, leider hat bei mir die UND-Verknüpfung nicht funktioniert und das Makro hat zb "bcd" nur am Zellenanfang gesucht. Die Zelle beinhaltet aber nicht immer die gleiche Zeilenanzahl, und bcd kann auch mitten im Wort oder am Zellen ende stehen.
Wäre über Hilfe sehr dankbar!
Vielen Dank im Voraus

Bild

Betrifft: AW: Makro: Wenn best. Text enthalten,kop. in Reiter
von: Matthias
Geschrieben am: 25.08.2015 19:12:26
Guten Abend Braun,
dies müsste eigentlich deinen Anforderungen genügen:

Option Explicit
Sub Kopieren()
 
Dim wksQuelle As Range, wksZiel As Range
Dim rZelle As Range
Dim sSuchbegriff  As String
Dim sSuchbegriff2  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"
' 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 Then
               .Rows(rZelle.Row).Copy Destination:=wksZiel.Rows(lZeileZ) ' kopiere Zeile
             End If
             Set rZelle = .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
Überprüfe bitte vorher die Bezüge was deine Tabellen angeht. Bitte benutze den Code-Namen der Tabellenblätter, dann kannst du sie jederzeit umbennen ohne Probleme mit dem Makro zu bekommen. Falls du nicht weist wo du den herbekommst, Google ist da sehr hilfreich.
Der Code ist ungetestet, da ich heut an einer Zumutung von Rechner sitze, wo nichtmal Excel drauf ist. Hoffe das funktioniert auf Anhieb,
lg Matthias

Bild

Betrifft: AW: Makro: Wenn best. Text enthalten,kop. in Reiter
von: Matthias
Geschrieben am: 25.08.2015 20:04:42
Da ham wir auch schon die ersten Fehler:
Dim wksQuelle As Range, wksZiel As Range
k.A. wie das passieren konnte, muss aber lauten:
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Set rZelle = .FindNext(rZelle)
muss heißen:
Set rZelle = .Range("C:C").FindNext(rZelle)
Da muss mehr Kaffee her!
lg Matthias

Bild

Betrifft: AW: Makro: Wenn best. Text enthalten,kop. in Reiter
von: braun
Geschrieben am: 26.08.2015 08:49:17
Guten Tag,
Ich habe es eben ausprobiert, allerdings bingt er mir beim Ausführen gleich "Fehler beim Kompilieren, Variable nicht definiert" und markiert mir Tabelle2, obwohl sie bei mir als Tabelle2 definiert ist.
Zudem hätte ich doch noch gern eine oder verknüfung bei der zweiten Spalte. Das Makro soll nach GER oder FR schauen. Wie kann man das noch mit einbauen?
Vielen Dank für die Hilfe!! Viele Grüße

Bild

Betrifft: AW: Makro: Wenn best. Text enthalten,kop. in Reiter
von: braun
Geschrieben am: 26.08.2015 09:27:17
Guten Morgen
Dass mit der Tabellenumbenennung und mit dem Kopieren habe ich jetzt so gelöst:
Sheets(1).Select
Sheets.Add After:=Sheets(1)
Sheets(2).Name = "Beispiel123"
Sheets(1).Select
Rows("1:1").Select
Selection.Copy
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Sheets(1).Select
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim rZelle As Range
Dim sSuchbegriff As String
Dim sSuchbegriff2 As String
Dim firstAddress As String
Dim lZeileZ As Long

Application.ScreenUpdating = False
Application.Calculation = xlManual

' -- Bezüge --
Set wksQuelle = Sheets(1)
Set wksZiel = Sheets(2) ' "Filter"
sSuchbegriff = "bcd"
sSuchbegriff2 = "GER"
Wenn ich jetzt den kompletten Code ausführe, kopiert es mir nur die letzte gefundene Zelle in das Tabellenblatt, es wird quasi immer überschrieben
Ist das ein FEhler in der Schleife?
Viele Grüße


Bild

Betrifft: AW: Makro: Wenn best. Text enthalten,kop. in Reiter
von: Matthias
Geschrieben am: 26.08.2015 11:43:56
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

Bild

Betrifft: AW: Makro: Wenn best. Text enthalten,kop. in Reiter
von: braun
Geschrieben am: 26.08.2015 13:01:51
Vielen vielen Dank!

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro, dass Daten aus Excel in eine Datei überträg"