Change-Frage

Hallo,
mir hat jemand dankenswerterweise bei Folgendem geholfen:


Private Sub Worksheet_Change(ByVal Target As Range)
Set n = Cells(1, 2).Find("T E R M I N E")
If n Is Nothing Then
Application.Run "finde_Inhalt_in_B"
Application.SendKeys "{F2}"
End If
End Sub

Sub finde_Inhalt_in_B()
Application.Run "stopptimer"
Dim Found As Range
Dim LoLetzte As Long
Dim sSearch As String
sSearch = Range("b1")
With Worksheets("Lehrbericht")
LoLetzte = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
Set Found = .Range(Cells(ActiveCell.Row + 1, 2), Cells(LoLetzte, 2)).Find(sSearch, Range("b" & LoLetzte), , xlPart, , xlNext)
If Found Is Nothing Then Exit Sub 'falls nicht gefunden wird
Found.Select
End With
End Sub

Warum geht Change nicht auch ohne "Application.SendKeys "{F2}"" ?
Läßt sich der Suchvorgang nicht fortsetzen, ohne vorher in den Doppelklickmodus zu kommen?
Wiedermal Danke für eure Hilfe.
Gruß
Karsten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Change-Frage

04.04.2009 13:34:07

Tino

AW: Change-Frage

04.04.2009 22:46:47

Karsten

AW: Change-Frage

05.04.2009 08:52:18

Tino

AW: Change-Frage

05.04.2009 12:43:48

Karsten

AW: Change-Frage

05.04.2009 13:32:44

Tino

AW: Change-Frage

05.04.2009 19:13:51

Karsten

Private Sub Worksheet_Change(ByVal Target As Range) Dim sSearch As String Dim LoLetzte As Long Dim Found As Range If InStr(Cells(1, 2), "T E R M I N E") > 0 Then sSearch = Range("B1") With Worksheets("Lehrbericht") LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Rows.Count, .Cells(.Rows.Count, 2).Row) _ Set Found = .Range(.Cells(ActiveCell.Row + 1, 2), .Cells(LoLetzte, 2)). _ Find(sSearch, .Range("b" & LoLetzte), , xlPart, , xlNext) If Not Found Is Nothing Then Application.Goto Found End With End If End Sub

Hallo,
Versuche es mal hiermit, damit kannst Du mit der Taste F12 Suchen.
kommt als Code in Tabelle Lehrbericht

Option Explicit 
 
Private Sub Worksheet_Activate() 
 If ActiveCell.Column = 2 Then 
  Application.OnKey "{F12}", "SucheUeberF12" 
 End If 
End Sub 
 
Private Sub Worksheet_Deactivate() 
 Application.OnKey "{F12}" 
End Sub 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
 If Target.Column = 2 Then 
  Application.OnKey "{F12}", "SucheUeberF12" 
 Else 
  Application.OnKey "{F12}" 
 End If 
End Sub

Modul Modul1

Option Explicit 
 
Sub SucheUeberF12() 
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 Application.Goto Found 
    End With 
 Application.EnableEvents = True 
End Sub

Gruß Tino

Option Explicit Sub SucheUeberF12() 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" Set Found = Nothing End If End If If Not Found Is Nothing Then Application.Goto Found End With Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread