Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Suche, finde und dann aber nur wenn... VBA

Suche, finde und dann aber nur wenn... VBA
20.05.2014 17:00:26
Thorben
Moinsen alle zusammmen,
könnt ihr mir bitte helfen den Code hier anzupassen, ich blicke nicht wo ich anpacken muss:
Es soll nur grün eingefärbt werden wenn für Set rSuche = rFinde.Find(what:=.Cells(I, 1), LookAt:=xlWhole) zusätzlich Offset(0,1) = "" Wahr ist.
QuellCode ist ausm WWW, angepasst und lüppt soweit.
Krieg das nicht hin.
Danke schon mal und
MfG
Thorben
  • 
    Sub check()
    Dim rFinde As Range, rSuche As Range ' das ist mal eine einfache Variablendeklaration
    Dim strFirst As String
    Dim lngReihe As Long, lngLetzte As Long
    Dim I As Integer
    With Workbooks("Daten.xlsm").Sheets("Hinweise")
    lngLetzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
    _
    Count) 'letzte volle Zeile in Sheet* ermitteln, da stehen die Suchstrings in den Zeilen von  _
    Spalte a
    End With
    Set rFinde = Sheets("Suche").Range("A:A") ' wo soll gesucht werden, naja, in Spalte A  _
    Sheet*, da stehen die zu vergleichenden Werte
    With Workbooks("Daten.xlsm").Sheets("Hinweise")
    For I = 2 To lngLetzte ' Suchschleife, da ja mehr als nur ein Suchwert
    Set rSuche = rFinde.Find(what:=.Cells(I, 1), LookAt:=xlWhole) ' .cells.. ist der  _
    jeweilige Suchwert
    If Not rSuche Is Nothing Then ' wenn, was gefunden wurde
    strFirst = rSuche.Address ' merke dir die erste gefundene Zelle (weil können ja  _
    mehr sein)
    Do ' weiter Schleife, um die anderen gleichen zu finden
    lngReihe = rSuche.Row ' wir merken uns die Zeile wo in Sheet* der Suchstring  _
    steht
    Sheets("Suche").Range("A" & lngReihe).Cells.Interior.ColorIndex = 4 'Zelle  _
    einfärben
    Set rSuche = rFinde.FindNext(rSuche) ' wir suchen den nächsten, gleichen  _
    Suchstring
    Loop While Not rSuche Is Nothing And rSuche.Address  strFirst 'das tun wir  _
    solange, bis wir wieder bei der ersten Adresse sind und somit alle gefunden wurden.
    End If
    Next I
    End With
    Sheets("Suche").Select
    MsgBox ("Fertig!")
    End Sub
    

  • 10
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Suche, finde und dann aber nur wenn... VBA
    20.05.2014 17:34:57
    Daniel
    Hi
    du könntest ausnutzen, dass die FIND-Funktion nur in sichtbaren Zellen sucht und die Zellen, die nicht gefärbt werden sollen, per Autofilter ausblenden.
    dazu brauchst du diese Programmzeile an Abfang:
    Workbooks("Daten").Sheets("Suche").Columns(2).Autofilter Field:=1, Criteria1:=""
    

    und am Ende diese um den Autofilter wieder auszuschalten:
    Workbooks("Daten").Sheets("Suche").Columns(2).Autofilter
    

    du könntest allerdings auch direkt über den Autofilter gehen, anstatt die umständliche FIND-Schleife.
    Seit Excel 2007 ist es möglich, im Autofilter nach mehreren Filterkriterien gleichzeitig zu filtern, so dass du die Texte aus den Hinweisen direkt im Autofilter als Kriterium angeben kannst:
    Sub check2()
    Dim FilterTexte As Variant
    Dim Zelle As Range
    Dim i As Long
    With Sheets("Hinweise")
    With .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
    FilterTexte = WorksheetFunction.Transpose(.Value)
    End With
    End With
    With Sheets("Suche").UsedRange
    .Columns(1).Interior.ColorIndex = xlNone
    .AutoFilter field:=1, Criteria1:=FilterTexte, Operator:=xlFilterValues
    .AutoFilter field:=2, Criteria1:=""
    If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
    .Resize(.Rows.Count - 1, 1).Offset(1, 0).Interior.ColorIndex = 4
    End If
    .AutoFilter
    End With
    End Sub
    
    Gruß Daniel

    Anzeige
    das will noch nicht so richtig...
    21.05.2014 10:00:35
    Thorben
    Hallo Daniel,
    danke, Theori hab ich verstanden aber in der Praxis fehlts noch.
    Habe die Tabelle entsprechend gefiltert (wie oben beschrieben) und (müsste) jetzt raten wo
    SpecialCells(xlCellTypeVisible) hinzukommen muss.
    So gehts nicht...: er markiert alles grün!
    Set rSuche = rFinde.Find(what:=.Cells.SpecialCells(xlCellTypeVisible)(i, 1), LookAt:=xlWhole)
    Bei deinem 2 Code bekomme ich Laufzeitfehler 6 - Überlauf
    Debuggger hier: FilterTexte = WorksheetFunction.Transpose(.Value)
    wobei mir auffällt Dim i As Long findet keine Anwendung !
    Kannst Du nochmal drübergucken.
    Danke schonmal
    MfG
    Thorben

    Anzeige
    AW: das will noch nicht so richtig...
    21.05.2014 10:30:24
    Daniel
    wenn du mir die Datei dazu schicken würdest, wäre es leichter den Fehler zu finden.
    bei mir hat der Code mit einfachen Testdateien funktioniert.
    wenn du die erste Möglichkeit ausprobieren willt, dann darfst du die Zeile mit Set rSuche = .Find(...) nicht verändern, die muss genauso bleiben wie sie ist.
    du musst nur vorher irgendwann den Autofilter akivieren, so dass die Zeilen, die auf keinen Fall gefärbt werden sollen (also die die in Spalte B leer sind) ausgeblendet werden.
    das .SpecialCells(xlcelltypevisible) ist unnötig, da die .FIND-Funktion automatisch nur die sichtbaren Zeilen berücksichtigt.
    kleine Frage noch: vieviele Zeilen hat deine Tabelle, wieviele Leerzellen gibt es in Spalte B und vieviele Zellen sollen gefärbt werden?
    Gruß Daniel

    Anzeige
    AW: das will noch nicht so richtig...
    21.05.2014 10:59:44
    Thorben
    Hallo Daniel,
    kurz beschrieben:
    Sheet "Suche": Zahlen in Spalte A2:A5000
    Sheet "Hinweise": Zahlen in Spalte A2:A50000 und in Spalte B2:B50000 Text
    Vergleiche Spalte A in Sheet Suche mit Spalte A in Sheet Hinweise
    und Markiere in Sheet Suche nur dann "grün" wenn in Sheet "Hinweise" Nummer gefunden und in Spalte B etwas eingetragen ist.
    Ich hoffe das ist ok sonst lade ich ne Mappe hoch...
    MfG
    Thorben

    AW: das will noch nicht so richtig...
    21.05.2014 11:17:41
    Daniel
    Hi
    hast du hier nicht gegenüber deiner ersten Beschreibung "Suche" und "Hinweise" vertauscht?
    Sorry, aber sowas solltest du immer klar, eindeutig und in Übereinstimmung mit deiner Datei beschreiben, wenn du funktionierende Lösungne haben willst.
    gruß Daniel

    Anzeige
    in Code1 wird doch in "Suche" grün markiert!
    21.05.2014 12:13:51
    Thorben
    Sheets("Suche").Range("A" & lngReihe).Cells.Interior.ColorIndex = 4
    oder habe ich da jetzt was durcheinander gebracht...
    Dann an dieser Stelle Entschuldigung.
    MfG

    AW: lade bitte eine Beispieldatei hoch
    21.05.2014 12:22:46
    Daniel
    und markiere die Zellen, die der Code grün machen soll.
    Dann muss man sowas nicht diskutieren.
    Gruß Daniel

    mit bsp Mappe ;o) ...sorry für mein Kauderwelsch
    22.05.2014 08:28:12
    Thorben
    Hallo Daniel,
    sorry das ich mich so kompliziert ausgedrückt habe.
    Im erklären von solchen Dingen bin ich wahrlich nicht besonders gut und verhädere mich gerne mal ;o)
    Anbei eine bsp.Mappe
    https://www.herber.de/bbs/user/90782.xlsm
    Im Blatt "Hinweise" stehen bis zu 50000 Nummern - ohne Duplikate - in Spalte A
    Nur im Blatt "Suche" können Duplikate vorkommen.
    Ich hoffe damit gehts!?
    Danke nochmal und Gruß
    Thorben

    Anzeige
    AW: umständliches VBA - mit Excelformeln einfacher
    22.05.2014 11:20:58
    Daniel
    Hi
    ja geht.
    aber warum so eine aufwendige VBA-Programmierung?
    im Prinzip kann man sich ja den Wert aus "Hinweise" mit der SVERWEIS-Funktion nach "Suche" in eine Hilfsspalte einlesen und sieht dann sofort, was gefärbt werden muss und was nicht, dh man kann mit dem autofilter dann in dieser Hilfsspalte filtern und färben.
    diese einfache Vorgehensweise kann man natürlich auch in VBA umsetzen und hat dann eine kurze und in der Regel auch sehr schnelle lösung für seine Aufgabe.
    Sub test()
    With Sheets("Hinweise")
    .Range("A:B").Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
    End With
    With Sheets("Suche").UsedRange
    With .Columns(.Columns.Count + 1)
    .FormulaR1C1 = "=if(vlookup(rc1,Hinweise!C1,1,true)=RC1,if(vlookup(rc1,Hinweise!C1:C2,2, _
    true)="""",0,""x""),0)"
    Intersect(.Offset(0, 1 - .Column), .SpecialCells(xlCellTypeFormulas, 2).EntireRow). _
    Interior.ColorIndex = 4
    .ClearContents
    End With
    End With
    End Sub
    
    im Code benutze ich nicht den Autofilter, sondern die Funktion "gehe zu - inhalte" um die zum färben markierten Zeilen auszuwählen.
    Gruß Daniel

    Anzeige
    ich die Spreu Du der Weizen...! Danke owT ;o)
    22.05.2014 13:12:19
    Thorben
    .

    313 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige