Microsoft Excel

Herbers Excel/VBA-Archiv

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

Suchmakro | Herbers Excel-Forum


Betrifft: Suchmakro von: Karsten
Geschrieben am: 15.11.2009 20:41:16

Hallo,

Sepp hat mir vor einiger Zeit in folgender Beispieldatei einen Suchmakro geschrieben, den ich für meine Bedürfnisse entsprechend abgeändert habe.

https://www.herber.de/bbs/user/65933.xls

In B1 wird der Suchbegriff eingegeben. Sollte er nicht gefunden werden, soll z.B. eine Meldung in einer msg-Box angezeigt werden. Kann mir jemand diesen Makro dementsprechend erweitern?

Danke.

Gruß
Karsten

  

Betrifft: AW: Suchmakro von: Josef Ehrensberger
Geschrieben am: 15.11.2009 20:51:28

Hallo Karsten,

kann meinen Code kaum wiedererkennen;-)) Was versuchst du denn da zusammenzumurksen?


Gruß Sepp



  

Betrifft: AW: Suchmakro von: Karsten
Geschrieben am: 15.11.2009 21:47:26

Hallo Sepp,

hätte ich doch mein Zeug besser weggelassen, weil das Beispiel ist wirklich zu abgespeckt um noch glaubhaft dazustehen. In der richtigen Datei funktioniert jedenfalls alles bestens, auch wenn man die Codes hätte eleganter schreiben können. Ich will dir, ehrlich gesagt, weiter nichts erklären oder ich müsste dir meine 2,25 MB große Datei privat zusenden, was ich auch machen würde. Ich habs schon versucht mit "else" aber dann will er wieder noch irgenwo ein "if", wo ich wieder nicht weiß, was ich dahinterschreiben soll. Du weißt bestimmt schon was ich meine...

Gruß
Karsten


  

Betrifft: AW: Suchmakro von: Josef Ehrensberger
Geschrieben am: 15.11.2009 21:51:58

Hallo Karsten,

If IsNumeric(varResult) Then
  Application.Goto Cells(varResult, ActiveCell.Column)
  ActiveWindow.ScrollRow = ActiveCell.Row - 1
Else
  MsgBox "nada!"
End If



Gruß Sepp



  

Betrifft: AW: Suchmakro von: Karsten
Geschrieben am: 16.11.2009 08:52:19

Hallo Sepp,

danke, aber wo soll der Code konkret hin?

Gruß
Karsten


  

Betrifft: AW: Suchmakro von: Josef Ehrensberger
Geschrieben am: 16.11.2009 18:05:11

Hallo Karsten,

probier's mal so. (Achte auf den Code, der in's Modul der Tabelle1 gehört!)

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) = "B1" Then Set rng = Nothing
End Sub

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

Option Explicit
Public rng As Range
Public rngBereich As Range

Sub finde_Inhalt_in_B_ab_heute()
  'deklarationen gehören an den Anfang der Prozedur!
  Dim varRes As Variant
  Dim unterkante_1 As Range
  Dim Zeile1 As Long
  
  On Error GoTo ErrExit
  Application.EnableEvents = False
  
  With ActiveSheet
    If rng Is Nothing Then
      varRes = Application.Match(Clng(Date), .Range("A:A"), 0)
      If IsNumeric(varRes) Then
        Application.Goto Cells(varRes, ActiveCell.Column)
        ActiveWindow.ScrollRow = ActiveCell.Row - 1
        Set rngBereich = .Range(Cells(varRes, 2), .Cells(Rows.Count, 2))
        Set rng = rngBereich.Find(What:=.Cells(1, 2), LookIn:=xlValues, LookAt:=xlPart, After:=rngBereich.Cells(rngBereich.Rows.Count, 1))
      End If
    Else
      Set rng = rngBereich.Find(What:=.Cells(1, 2), LookIn:=xlValues, LookAt:=xlPart, After:=rng)
    End If
    
    If Not rng Is Nothing Then
      Application.Goto rng
      Set unterkante_1 = ActiveWindow.VisibleRange
      If ActiveCell.Row = unterkante_1.Row + unterkante_1.Rows.Count - 1 Or ActiveCell.Row = unterkante_1.Row + unterkante_1.Rows.Count - 2 Then
        Zeile1 = ActiveCell.Row
        rng.WrapText = True
        If Not Intersect(ActiveCell, unterkante_1) Is Nothing Then
          ActiveWindow.ScrollRow = WorksheetFunction.Max(1, Zeile1 - unterkante_1.Rows.Count / 1.2)
        End If
      End If
      Einfaerben_rot
    Else
      MsgBox "nada!"
      GoTo ErrExit
    End If
  End With
  
  ErrExit:
  
  Application.EnableEvents = True
End Sub

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Einfaerben_rot()
  Dim iLaenge As Integer
  Dim iPosit As Integer
  
  With ThisWorkbook.Worksheets("Tabelle1")
    iLaenge = Len(ActiveCell)
    ActiveCell.Characters(Start:=1, Length:=iLaenge).Font.ColorIndex = xlAutomatic
    If .Range("B1").Value <> "" Then
      iPosit = InStr(LCase(ActiveCell), LCase(.Range("B1").Value))
      If iPosit > 0 Then
        iLaenge = Len(.Range("B1").Value)
        ActiveCell.Characters(Start:=iPosit, Length:=iLaenge).Font.ColorIndex = 3
      End If
    End If
  End With
End Sub



Gruß Sepp



  

Betrifft: AW: Suchmakro von: Karsten
Geschrieben am: 16.11.2009 21:06:08

Hallo Sepp,

vorab mein Dank für die viele Mühe. Es läuft bis auf eine Sache, die ich vorher nicht hatte.
Beim ersten Start wird die erste Übereinstimmung gefunden.
Beim zweien Start wird wieder die erste Übereinstimmung gefunden.
Beim dritten Start wird die zweite Übereinstimmung gefunden usw.

Was kann da sein...?

Gruß
Karsten


  

Betrifft: AW: Suchmakro von: Josef Ehrensberger
Geschrieben am: 16.11.2009 23:34:36

Hallo Karsten,

kann es in deiner Beispieldatei nicht nachvollziehen, aber probier's so.

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

Option Explicit
Public rng As Range
Public rngBereich As Range

Sub finde_Inhalt_in_B_ab_heute()
  'deklarationen gehören an den Anfang der Prozedur!
  Dim varRes As Variant
  Dim unterkante_1 As Range
  Dim Zeile1 As Long
  
  On Error GoTo ErrExit
  Application.EnableEvents = False
  
  With ActiveSheet
    If rng Is Nothing Then
      varRes = Application.Match(Clng(Date), .Range("A:A"), 0)
      If IsNumeric(varRes) Then
        Application.Goto Cells(varRes, ActiveCell.Column)
        ActiveWindow.ScrollRow = ActiveCell.Row - 1
        Set rngBereich = .Range(Cells(varRes, 2), .Cells(Rows.Count, 2))
        Set rng = rngBereich.Find(What:=.Cells(1, 2), LookIn:=xlValues, LookAt:=xlPart, After:=rngBereich.Cells(rngBereich.Rows.Count, 1))
      End If
    Else
      Set rng = rngBereich.FindNext(rng)
    End If
    
    If Not rng Is Nothing Then
      Application.Goto rng
      Set unterkante_1 = ActiveWindow.VisibleRange
      If ActiveCell.Row = unterkante_1.Row + unterkante_1.Rows.Count - 1 Or ActiveCell.Row = unterkante_1.Row + unterkante_1.Rows.Count - 2 Then
        Zeile1 = ActiveCell.Row
        rng.WrapText = True
        If Not Intersect(ActiveCell, unterkante_1) Is Nothing Then
          ActiveWindow.ScrollRow = WorksheetFunction.Max(1, Zeile1 - unterkante_1.Rows.Count / 1.2)
        End If
      End If
      Einfaerben_rot
    Else
      MsgBox "nada!"
      GoTo ErrExit
    End If
  End With
  
  ErrExit:
  
  Application.EnableEvents = True
End Sub



Gruß Sepp



  

Betrifft: AW: Suchmakro von: Karsten
Geschrieben am: 17.11.2009 10:20:59

Hallo Sepp,

es liegt an:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "B1" Then Set rng = Nothing
End Sub
Wenn ich diesen Befehl weglasse, geht die Suche gleich weiter. Nun möchte ich ihn aber nicht weglassen, weil er für irgendwas wichtig sein wird. Kannst du mir bitte genau sagen, was er bedeutet? Liege ich da richtig mit: Wenn aktive Zelle = B1, dann mmm... was ist Set rng? Und muß rng gar nicht mit Dim rng As Range deklariert sein?

Gruß
Karsten


  

Betrifft: AW: Suchmakro von: Josef Ehrensberger
Geschrieben am: 17.11.2009 18:17:17

Hallo Karsten,

B1 ist die Adresse der Zelle in die der Suchbegriff eingegeben wird. Die Anweisung sorgt dafür, das bei einem neuen Suchbegriff eine neue Suche gestartet wird, bei mir wurde nämlich die Suche immer mit dem alten Suchbegriff vortgesetzt, weil die Variable rng ja bereits belegt war. Und rng ist doch im Modul1 als Public deklariert. Wenn es in deiner Originaldatei auch ohne diese Anweisung funktioniert, dann kannst du sie ruhig rausnehmen.


Gruß Sepp



  

Betrifft: AW: Suchmakro von: Karsten
Geschrieben am: 18.11.2009 08:08:49

Hallo Sepp,

ok. danke.

Gruß
Karsten