Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Eindeutige Werte bzw. Textteile suchen

Betrifft: Eindeutige Werte bzw. Textteile suchen von: Schaffhauser
Geschrieben am: 01.12.2015 21:14:09

Werte Damen & Herren

Kann man dieses Makro so umschreiben, das man auch eindeutige Werte bzw. Texte suchen kann?
Wenn ich jetzt z.B. 100 suche
erscheinen Zellen mit 100, 1100 etc.
* & "" schluckt mir das Makro nicht.

Besten Dank für eure HIlfe

Sub Suchen() ' SUCHEN - Sucht den eingegeben Text in sämtlichen Zellen und blendet diese ein.
Application.ScreenUpdating = False
Range("4:2000").EntireRow.Hidden = True
Dim Zelle As Range
Dim Bereich As Range
Dim rngGefunden As Range
Dim Eingabe As String 'String

Set Bereich = Range("B4:D" & Cells(Rows.Count, 1).End(xlUp).Row)

    Eingabe = UCase(InputBox("Was soll gesucht werden?", "Suchen"))
    If StrPtr(Eingabe) = 0 Then Exit Sub
    If Trim$(Eingabe) = "" Then Exit Sub

For Each Zelle In Bereich
    If InStr(UCase(Zelle.Value), Eingabe) > 0 Then
        If Not rngGefunden Is Nothing Then
            Set rngGefunden = Union(rngGefunden, Rows(Zelle.Row))
        Else
            Set rngGefunden = Rows(Zelle.Row)
        End If
    End If
Next Zelle

If Not rngGefunden Is Nothing Then
    rngGefunden.Select
    Selection.EntireRow.Hidden = False
    ActiveCell.Select
    ActiveSheet.OLEObjects("CommandButton1").Enabled = True
    ActiveSheet.OLEObjects("CommandButton2").Enabled = True
    ActiveSheet.OLEObjects("CommandButton3").Enabled = True
    ActiveSheet.OLEObjects("CommandButton4").Enabled = True
    ActiveSheet.OLEObjects("CommandButton5").Enabled = True
    MsgBox "Achtung! Die zu bearbeitende Zeile ist vorab zu selektieren!"
Else
    MsgBox ">> " & Eingabe & "<<, wurde nicht gefunden"
End If
Application.ScreenUpdating = True
End Sub

  

Betrifft: AW: Eindeutige Werte bzw. Textteile suchen von: Sepp
Geschrieben am: 01.12.2015 22:42:14

Hallo ?,

so kannst du auch mit Wildcards (*, ?) suchen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Suchen() ' SUCHEN - Sucht den eingegeben Text in sämtlichen Zellen und blendet diese ein.
Dim rngSearch As Range, rngFind As Range, rngHide As Range
Dim strInput As String, strFirst As String
Dim lngRow() As Long

Static CalculationMode As Long

On Error GoTo ErrorHandler

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  CalculationMode = .Calculation
  .Calculation = xlManual
  .DisplayAlerts = False
End With

Range("4:2000").EntireRow.Hidden = False

Redim lngRow(0)

Set rngSearch = Range("B4:D" & Cells(Rows.Count, 1).End(xlUp).Row)

strInput = InputBox("Was soll gesucht werden?", "Suchen")

If Len(Trim$(strInput)) Then
  
  Set rngFind = rngSearch.Find(What:=strInput, LookIn:=xlValues, _
    LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
  
  If Not rngFind Is Nothing Then
    strFirst = rngFind.Address
    Do
      If IsError(Application.Match(rngFind, lngRow, 0)) Then
        Redim Preserve lngRow(UBound(lngRow) + 1)
        lngRow(UBound(lngRow)) = rngFind.Row
        If rngHide Is Nothing Then
          Set rngHide = rngFind
        Else
          Set rngHide = Union(rngHide, rngFind)
        End If
      End If
      Set rngFind = rngSearch.FindNext(rngFind)
    Loop While Not rngFind Is Nothing And strFirst <> rngFind.Address
  End If
  
  If Not rngFind Is Nothing Then
    Range("4:2000").EntireRow.Hidden = True
    rngHide.EntireRow.Hidden = False
    ActiveCell.Select
    ActiveSheet.OLEObjects("CommandButton1").Enabled = True
    ActiveSheet.OLEObjects("CommandButton2").Enabled = True
    ActiveSheet.OLEObjects("CommandButton3").Enabled = True
    ActiveSheet.OLEObjects("CommandButton4").Enabled = True
    ActiveSheet.OLEObjects("CommandButton5").Enabled = True
    MsgBox "Achtung! Die zu bearbeitende Zeile ist vorab zu selektieren!"
  Else
    MsgBox ">> " & strInput & "<<, wurde nicht gefunden"
  End If
End If

ErrorHandler:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'nn'" & vbLf & String(25, "—") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, 81968, "VBA - Fehler in Prozedur - Suchen", .HelpFile, .HelpContext
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = CalculationMode
  .DisplayAlerts = True
  .StatusBar = False
End With

Set rngHide = Nothing
Set rngSearch = Nothing
Set rngFind = Nothing
End Sub


Gruß Sepp



 

Beiträge aus den Excel-Beispielen zum Thema "Eindeutige Werte bzw. Textteile suchen"