Such-Makro

Sub finde_Inhalt_in_B() Static Found As Range Application.EnableEvents = False With Worksheets("Lehrbericht") If Found Is Nothing Then Set Found = .Columns(2).Find(Range("B1"), Range("B1"), xlValues, 2, 1, 1, False) Else Set Found = .Columns(2).Find(Range("B1"), Found, xlValues, 2, 1, 1, False) End If If Not Found Is Nothing Then If Found.Row = 1 Then .Range("B1") = "T E R M I N E" On Error Resume Next Set Found = Nothing End If End If If Not Found Is Nothing Then Application.Goto Found End With Application.EnableEvents = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub a() Dim Suchbereich As Range Dim ersteZeile As Long, letzteZeile As Long ersteZeile = Application.Match(CLng(Date), Columns(1), 1) letzteZeile = Cells(Columns(1).Rows.Count, 1).End(xlUp).Row Set Suchbereich = Range(Cells(ersteZeile, 2), Cells(letzteZeile, 2)) MsgBox Suchbereich.Address End Sub

Hallo Gerd,
danke. Über die msgBox wird der Suchbereich ausgegeben, B390 - B1007 in meinem Falle. Das ist nicht das, was ich brauche. Ich bräuchte, dass die Suche nach dem Zellinhalt in B1 von der aktiven Zelle ausgeht und nicht über die komplett B-Spalte. Zur aktiven Zelle komme ich ja mit:
Dim varResult As Variant
varResult = Application.Match(CDbl(Date), Range("A:A"), 0)
If IsNumeric(varResult) Then Application.Goto Cells(varResult, ActiveCell.Column)
ActiveWindow.ScrollRow = ActiveWindow.ActiveCell.Row
With ActiveCell
Range(.Offset(-1, 0), .Offset(-1, 0)).Select
End With
Die "Findmethode" hat eben immer die komplette B-Spalte durchforstet. Wenn es mit einer anderen Methode auch geht, wäre mir natürlich auch recht.
Gruß
Karsten

Hallo Karsten,
ein Makkro mit Enter zu satrten ist in XL nonsense.
Das Makro wird bei iner eingabe in B2 gestartet und mit F3 wird weitergesucht.

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

Private Sub Workbook_Activate()
  Application.OnKey "{F3}", "finde_Inhalt_in_B"
End Sub

Private Sub Workbook_Deactivate()
  Application.OnKey "{F3}"
End Sub

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

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$1" Then
    Set rngBereich = Nothing
    Set rng = Nothing
    finde_Inhalt_in_B
  End If
End Sub

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

Public rng As Range
Public rngBereich As Range

Sub finde_Inhalt_in_B()
  Dim varRes

  With ActiveSheet
    If rng Is Nothing Then
      varRes = Application.Match(Clng(Date), .Range("A:A"), 0)
      If IsNumeric(varRes) Then
        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))
        If Not rng Is Nothing Then Application.Goto rng
      End If
    Else
      Set rng = rngBereich.FindNext(rng)
      If Not rng Is Nothing Then Application.Goto rng
    End If
  End With

End Sub

Gruß Sepp

Option Explicit Sub finde_Inhalt_in_B() Dim varM As Variant, rngSuch As Range, rngF As Range Application.EnableEvents = False With Worksheets("Lehrbericht") varM = Application.Match(CDbl(Date), .Range("A:A"), 0) If IsNumeric(varM) Then Set rngSuch = .Range(.Cells(varM, 2), .Cells(.Rows.Count, 2)) Set rngF = rngSuch.Find(.Cells(1, 2).Value, .Cells(.Rows.Count, 2), _ xlValues, 2, 1, 1, False) If rngF Is Nothing Then MsgBox .Cells(1, 2).Value & " am " & Date & " nicht gefunden" Else MsgBox .Cells(1, 2).Value & " gefunden in Zeile " & rngF.Row If rngF.Row = 1 Then .Range("B1") = "T E R M I N E" End If Else MsgBox "Datum nicht gefunden" End If End With Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread