Microsoft Excel

Herbers Excel/VBA-Archiv

Multisuche | Herbers Excel-Forum


Betrifft: Multisuche von: VolkerM
Geschrieben am: 05.12.2009 12:44:24

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

  

Betrifft: AW: Multisuche von: Josef Ehrensberger
Geschrieben am: 05.12.2009 12:54:23

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



  

Betrifft: AW: Multisuche von: VolkerM
Geschrieben am: 05.12.2009 12:59:36

Hallo Sepp

Vielen Dank und ein schönes WE.


Gruß Volker


  

Betrifft: Sorry,... nicht aktualisiert, Aber... von: Ramses
Geschrieben am: 05.12.2009 13:04:36

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


  

Betrifft: AW: Sorry,... nicht aktualisiert, Aber... von: Josef Ehrensberger
Geschrieben am: 05.12.2009 13:13:43

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



  

Betrifft: AW: Multisuche von: Ramses
Geschrieben am: 05.12.2009 13:02:05

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