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
Informationen und Beispiele zum Thema ToggleButton
BildScreenshot zu ToggleButton ToggleButton-Seite mit Beispielarbeitsmappe aufrufen

Excel Script Suchen und markieren

Betrifft: Excel Script Suchen und markieren von: Matthias Krug
Geschrieben am: 13.08.2014 13:32:40

Hallo Leute, ich hab ein kleines Problem bei einer von mir erstellten Excel Liste.

Die Liste beinhaltet mehrere Zeilen sowie Spalten.
Ich bin schon durch mehrere Foren gestoßen, jedoch ohne Erfolg.
Nun bin ich auf diese Seite gekommen und hoffe Ihr könnt mir helfen!

Ich habe einen Commandbutton, mit dem eine MessageBox aufgeht, in der ich ein Suchwort eingeben kann. Wenn es eine Übereinstimmung gibt färbt mir dieses Script die Zelle gelb.
Allerdings funktioniert das Script nur bei Spalte "A", ich will jedoch in jeder beliebigen Spalte nach einem Begriff suchen können.
Und wenn es möglich wäre sollte mir das Script bei einer Übereinstimmung die komplette Zeile von A bis N gelb färben, egal in welcher Spalte ich gesucht habe.
Achja und nochwas, bei dem jetzigen Script wird bei keiner Übereinstimmung kein Fehler ausgestoßen, das würde ich gerne ändern. Und wenn das Suchwort außerhalb des eingeblendeten bereichs ist soll er bitte dort hin springen! Danke


Hier das jetzige Script, mit dem es nur möglich ist einzelne Zellen zu färben und nur in Spalte A zu suchen geht:

Private Sub CommandButton2_Click()
Dim suchName As String
    Dim zeLLe As Range
    Dim markRange As Range
    
    ' Bei Diagrammblättern gleich raus
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub
    
    suchName = InputBox("Name eingeben:", "Suchfeld")
    If suchName = "" Then Exit Sub
    
    Application.ScreenUpdating = True
    
    With ActiveSheet
        ' Alte Markierung löschen
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Interior.ColorIndex = xlNone
        For Each zeLLe In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
            If InStr(LCase(zeLLe), LCase(suchName)) <> 0 Then
                If markRange Is Nothing Then
                    Set markRange = zeLLe
                Else
                    Set markRange = Union(markRange, zeLLe)
                End If
            End If
        Next
        If Not markRange Is Nothing Then
            With markRange.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
        End If
    End With
    Application.ScreenUpdating = True
End Sub

  

Betrifft: AW: Excel Script Suchen und markieren von: Rudi Maintaire
Geschrieben am: 13.08.2014 13:50:49

Hallo,

        For Each zeLLe In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(,14)
            If InStr(LCase(zeLLe), LCase(suchName)) <> 0 Then
                If markRange Is Nothing Then
                    Set markRange = .cells(zeLLe.row, 1).Resize(,14)
                Else
                    Set markRange = Union(markRange, .cells(zeLLe.row, 1).Resize(,14))
                End If
            End If
        Next

Gruß
Rudi


  

Betrifft: Nachtrag von: Rudi Maintaire
Geschrieben am: 13.08.2014 13:57:32

Hallo,
hab deine 'nochwas' vergessen.

    If Not markRange Is Nothing Then
      With markRange.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
      End With
      Application.Goto markRange(1), True
    Else
      MsgBox "nix gefunden", , "gebe bekannt ..."
    End If

Gruß
Rudi


  

Betrifft: AW: Nachtrag von: Matthias Krug
Geschrieben am: 13.08.2014 14:08:12

Das sieht ja schonmal sehr gut aus! Schaffst du es jetzt noch bei einer Übereinstimmung die ganze Zeile (von A bis M) gelb zu markieren?


  

Betrifft: is doch owT von: Rudi Maintaire
Geschrieben am: 13.08.2014 14:13:57




  

Betrifft: AW: is doch owT von: Matthias Krug
Geschrieben am: 13.08.2014 14:17:17

Was heißt das denn? ^^


  

Betrifft: was das heißt von: Rudi Maintaire
Geschrieben am: 13.08.2014 14:21:44

Übereinstimmung wird von A bis N markiert.


  

Betrifft: AW: was das heißt von: Matthias Krug
Geschrieben am: 13.08.2014 14:28:35

Bei mir wird nur Spalte A markiert...hier nochmal der gesamte Code, vielleicht kannst du nochmal drüber schauen?

Private Sub CommandButton2_Click()
Dim suchName As String
    Dim zeLLe As Range
    Dim markRange As Range
    
    ' Bei Diagrammblättern gleich raus
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub
    
    suchName = InputBox("Name eingeben:", "Suchfeld")
    If suchName = "" Then Exit Sub
    
    Application.ScreenUpdating = True
    
    With ActiveSheet
        ' Alte Markierung löschen
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Interior.ColorIndex = xlNone
        For Each zeLLe In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
            If InStr(LCase(zeLLe), LCase(suchName)) <> 0 Then
                If markRange Is Nothing Then
                    Set markRange = zeLLe
                Else
                    Set markRange = Union(markRange, zeLLe)
                End If
            End If
        Next
        If Not markRange Is Nothing Then
            With markRange.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
             Application.Goto markRange(1), True
    Else
      MsgBox "Kein Eintrag gefunden", , "Suchfeld"
        End If
    End With
    Application.ScreenUpdating = True
End Sub



  

Betrifft: siehe mein 1. Beitrag owT von: Rudi Maintaire
Geschrieben am: 13.08.2014 14:35:04




  

Betrifft: AW: siehe mein 1. Beitrag owT von: Matthias Krug
Geschrieben am: 13.08.2014 14:40:18

Aaah wunderbar, jetzt hab ichs verstanden und auch reinkopiert, funktioniert einwandfrei!!!

Eine letzte Frage hätte ich allderdings noch, ich hoffe diese kannst du mir auch noch beantworten?!
Zuzüglich diesem CommandButton "suchen" habe ich noch einen, wo ich alle Filter rücksetzen kann.
Jetzt möchte ich noch, wenn ich den Button "Filter rücksetzen" drücke, dass die gelbe Markierung wieder verschwindet. Hier der Code:

Private Sub CommandButton1_Click()
ToggleButton1.Value = False
ToggleButton2.Value = False
ToggleButton3.Value = False
ToggleButton4.Value = False
ToggleButton5.Value = False
ToggleButton7.Value = False
ToggleButton8.Value = False
ToggleButton9.Value = False
Dim intI As Integer

With Worksheets("AUMA A3")
    For intI = 1 To 14
     Selection.AutoFilter Field:=intI
    Next
End With
End Sub


Vielen Dank schonmal!!!!


 

Beiträge aus den Excel-Beispielen zum Thema "Excel Script Suchen und markieren"