Match versus Find

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim strMatch As String, vntRetVal As Variant, lngCol As Long Dim Bereich As Range, Fund As Range 'strMatch = InputBox("suchbegriff") 'If StrPtr(strMatch) = 0 Or strMatch = "" Then Exit Sub strMatch = "Apfel" 'Testwert With ActiveSheet For lngCol = 1 To 109 Set Bereich = .Range(.Cells(2, lngCol), .Cells(3000, lngCol)) Do vntRetVal = Application.Match(strMatch, Bereich, 0) If IsNumeric(vntRetVal) Then If Not Fund Is Nothing Then Set Fund = Union(Fund, .Cells(Bereich.Row + vntRetVal - 1, lngCol)) Else Set Fund = .Cells(Bereich.Row + vntRetVal - 1, lngCol) End If Set Bereich = Range(.Cells(Bereich.Row + vntRetVal, lngCol), .Cells(3000, lngCol)) End If Loop While IsNumeric(vntRetVal) And Bereich.Row

Hallo,
so müsste es über einen Beliebigen Zellbereich funzen.

Sub Test()
Dim Bereich As Range, rZellen As Range
Dim LCol As Long, tempCol As Long
Dim SuchWert, varRow

SuchWert = "Apfel"

'hier den Suchbereich anpassen********************************** 
Set Bereich = Range("A3:Z100")

    For LCol = 1 To Bereich.Columns.Count
       
       tempCol = 1
       
       Do While IsNumeric(varRow)
         
            varRow = Application.Match(SuchWert, Bereich.Columns(LCol).Range(Cells(tempCol, 1), Cells(Bereich.Rows.Count, 1)), 0)
            
               If IsNumeric(varRow) Then
                  If rZellen Is Nothing Then
                   Set rZellen = Bereich(varRow + tempCol - 1, LCol)
                   tempCol = tempCol + varRow
                  Else
                   Set rZellen = Union(rZellen, Bereich(varRow + tempCol - 1, LCol))
                   tempCol = tempCol + varRow
                  End If
               End If
       
       Loop
    
       varRow = 0
    Next LCol


If Not rzelle Is Nothing Then MsgBox rZellen.Address

End Sub

Gruß Tino

Option Explicit Sub Beispiel2() Dim iWert As Integer Dim iZei As Integer Dim iSp As Integer iWert = 32 For iSp = 1 To 30 iZei = CInt(Application.Match(iWert, Columns(iSp), 0)) Cells(iZei, iSp).Interior.ColorIndex = 4 Next iSp End Sub

Sub test2() Dim R As Range, Fund As Range Set R = ActiveSheet.Columns("A:DE") R.Replace "Apfel", True, xlWhole On Error Resume Next Set Fund = R.SpecialCells(xlCellTypeConstants, xlLogical) On Error GoTo 0 If Not Fund Is Nothing Then R.Replace True, "Apfel", xlWhole MsgBox Fund.Address Else MsgBox "Apfel" & " wurde nicht gefunden!" End If End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Match versus Find

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread