Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1120to1124
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

Multisuche

Multisuche
VolkerM
Hallo Forum
Ich möchte eine Tabelle nach mehreren Suchbegriffen durchsuchen lassen.
Die Suchbegriffe sollen sich aus der aktiven Zeile und den Spalten B bis zur letzten befüllten Zelle der aktiven Zeile zusammensetzen.
Die Tabelle sieht so aus, dass die Anzahl der befüllten Zellen einer Zeile unterschiedlich ist.
Leerzellen innerhalb einer Zeile gibt es jedoch nicht.
Wie kann man variabel den Bereich der Suchbegriffe bestimmen ?
Sub Markieren()
Cells.Interior.ColorIndex = xlNone
Dim rngFind As Range
Dim strFirst As String
Dim strFindArray() As Variant
Dim intCount As Integer
strFindArray = Array(ActiveCell.Value, ActiveCell.Offset(0, 1).Value, ActiveCell.Offset(0, 2). _
Value)  ' ?
For intCount = 0 To UBound(strFindArray)
Set rngFind = Cells.Find(What:=strFindArray(intCount), LookIn:=xlValues, LookAt:=xlWhole)
If Not rngFind Is Nothing And ActiveCell.Value  "" Then
strFirst = rngFind.Address
Do
rngFind.Interior.ColorIndex = 6
Set rngFind = Cells.FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address  strFirst
End If
Set rngFind = Nothing
strFirst = vbNullString
Next
End Sub

Danke im Voraus
Gruß Volker

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Multisuche
05.12.2009 12:54:23
Josef
Hallo Volker,
ein Bereich kann direkt einem Array zugewiesen werden.
Sub Markieren()
  Dim rngFind As Range
  Dim strFirst As String
  Dim strFindArray As Variant
  Dim intCount As Integer
  
  Cells.Interior.ColorIndex = xlNone
  
  With ActiveCell
    strFindArray = Range(Cells(.Row, 2), Cells(.Row, Cells(.Row, Columns.Count).End(xlToLeft).Column))
  End With
  
  For intCount = 1 To UBound(strFindArray, 2)
    If strFindArray(1, intCount) <> "" Then
      Set rngFind = Cells.Find(What:=strFindArray(1, intCount), LookIn:=xlValues, LookAt:=xlWhole)
      If Not rngFind Is Nothing Then
        strFirst = rngFind.Address
        Do
          rngFind.Interior.ColorIndex = 6
          Set rngFind = Cells.FindNext(rngFind)
        Loop While Not rngFind Is Nothing And rngFind.Address <> strFirst
      End If
      Set rngFind = Nothing
      strFirst = vbNullString
    End If
  Next
End Sub

Gruß Sepp

Anzeige
AW: Multisuche
05.12.2009 12:59:36
VolkerM
Hallo Sepp
Vielen Dank und ein schönes WE.
Gruß Volker
Sorry,... nicht aktualisiert, Aber...
05.12.2009 13:04:36
Ramses
Hallo Sepp
die Idee hatte ich zuerst auch, allerdings wird bei mir das Array nicht gefüllt mit den Werten aus dem zellbereich.
Ubound(Array) brachte immer 0.
Hast du eine Erklärung dafür an was das liegen kann ?
Gruss Rainer
AW: Sorry,... nicht aktualisiert, Aber...
05.12.2009 13:13:43
Josef
Hallo Rainer,
Erklären kann ich mir das jetzt auch nicht, bei mir hat's gefunzt.
Besser ist es allerdings, die Zuweisung so vorzunehmen
With ActiveCell
  strFindArray = Range(Cells(.Row, 2), Cells(.Row, Application.Max(3, Cells(.Row, Columns.Count).End(xlToLeft).Column)))
End With

sonst knallt man auf einen Fehler, wenn nur eine Zelle im Bereich gefüllt ist,
weil "strFindArray" dann nur ein String ist und kein Array.
Gruß Sepp

Anzeige
AW: Multisuche
05.12.2009 13:02:05
Ramses
Hallo
probier mal
Option Explicit

Sub Markieren()
    Cells.Interior.ColorIndex = xlNone
    Dim rngFind As Range
    Dim strFirst As String
    Dim strFindArray() As Variant
    Dim intCount As Integer, i As Integer
    ReDim Preserve strFindArray(Columns.Count)
    For i = 1 To Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Column
        strFindArray(i - 1) = Cells(ActiveCell.Row, i)
    Next
    ReDim Preserve strFindArray(UBound(strFindArray))
    For intCount = 0 To UBound(strFindArray)
        Debug.Print strFindArray(intCount)
        Set rngFind = Cells.Find(What:=strFindArray(intCount), LookIn:=xlValues, LookAt:=xlWhole)
        If Not rngFind Is Nothing And ActiveCell.Value <> "" Then
            strFirst = rngFind.Address
            Do
                rngFind.Interior.ColorIndex = 6
                Set rngFind = Cells.FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirst
        End If
        Set rngFind = Nothing
        strFirst = vbNullString
    Next
End Sub

Gruss Rainer
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige