hi fedjo ^^

ein beispiel

gruss nighty

Option Explicit
Sub Suchen()
    Dim suche As Range
    Set suche = ActiveSheet.Range("C2" & ":C" & ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row).Find(Range("A5"), lookat:=xlWhole)
    If Not suche Is Nothing Then
        ActiveSheet.Cells(suche.Row, suche.Column).Select
    End If
End Sub

hi fedjo :-)

oder besser so ^^

gruss nighty

Option Explicit
Sub Suchen()
    Dim suche As Range
    With Worksheets("Lieferzeiten")
        Set suche = .Range("C2" & ":C" & .Cells(Rows.Count, 3).End(xlUp).Row).Find(.Range("A5"), lookat:=xlWhole)
        If Not suche Is Nothing Then
            .Cells(suche.Row, suche.Column).Select
        End If
    End With
End Sub

hi fedjo :-)

dann noch einige erklaerungen zu deinem makro ^^

gruss nighty

Sub Suchen()
'lngI ist ueberfluessig da nicht benutzt wird
'strSuch ist als string deklariert,richtig waere integer
'lngAnz ist ueberfluessig da nicht benutzt wird
Dim lngI As Long, strSuch As String, lngAnz As Long
'on error resume next ist in dieser weise nicht erlaubt
On Error Resume Next
strSuch = Sheets("Lieferzeiten").Range("A5").Value
'lngI ist ueberfluessig dadurch ist die ganze zeile ueberfluessig
lngAnz = WorksheetFunction.CountIf(Columns(3), strSuch)
'find function hat fehlerhafte funde durch falsche parameter wie z.b. LookIn:=xlValues
'findfunction geht in den debug modus durch fehlende abfrage auf fund
Columns(3).Find(What:=strSuch, LookIn:=xlValues, MatchCase:=False).Activate
'ueberfluessige zeile einer bruchstueckhaften wiederholungsschleife
For lngI = 1 To lngAnz - 1
End Sub

Hallo nighty,
danke für die schnelle Antwort.
habe den Code etwas verändert, funktioniert super.
Daduch ergibt sich gleich noch eine Frage.
Wie kann ich von der ActiveCell (z.B. F10) bis (F1) alles löschen?

Gruß
fedjo

hi fedjo :-)

eine variante

gruss nighty

Range("F1:F" & ActiveCell.Row) = ""

Hallo nighty,
mein Code sieht jetzt so aus und funktioniert auch im Prinzip, aber für einen Spezialisten gibt es sicherlich einige Verbesserungen. Vielleicht könntest du dich noch mal mit dem Makro befassen.
Danke dir im Voraus für deine Hilfe.
Gruß
fedjo

Sub Suchen()
'aktuelle KW suchen
Dim strSuch As Integer
On Error Resume Next
strSuch = Sheets("Lieferzeiten").Range("A5").Value
lngAnz = WorksheetFunction.CountIf(Columns(3), strSuch)
Columns(3).Find(What:=strSuch, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Offset(0, 3).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(3, 0)).Copy
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
strSuch = Sheets("Lieferzeiten").Range("A5").Value
lngAnz = WorksheetFunction.CountIf(Columns(3), strSuch)
Columns(3).Find(What:=strSuch, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Offset(0, 3).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(3, 0)).ClearContents
Range("F2:F" & ActiveCell.Row).ClearContents
End Sub

Hallo Fedjo ^^

immer gern :-)

setz mich sonntag gleich ran

gruss nighty

nur mal so nebenbei

ich seh da schon wieder on error resume next :-))

dazu einige erlaeuterungen

on error resume next schaltet die fehlerroutine von excel kommplett ab

sinvolle einsatzgebiete waeren hier kleinere functionen z.b.

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function

auch hier liesse sich das on error resume next zwar vermeiden aber dann haette man hier ein vielfaches an zeilen,da es sich hier aber nur um eine zeile handelt ist es eben sinnvoller es einzusetzen da es keinen weiteren code beeinflussen kann

aber toedlich bei laengeren codes ,da nun nicht mehr eine fehlersuche stattfinden kann und fehlerhafte codes als lauffaehig bezeichnet werden obwohl intern es nur so von fehlern wimmelt

eine andere alternative waere on error goto errorhaendler

anhand von der systemvariablen err liesse sich jetzt gezielt auf fehler reagieren und es sollte eine korrigierung mit anschliessenden ruecksprung erfolgen

hier mal ein beispiel einer fehlerbehandlung

Option Explicit
Sub Beispiel()
    On Error GoTo Errorhaendler
    Rem beliebiger code
    End
Errorhaendler:
    If Err = 1004 Then
        Rem beliebiger code zum korrigieren
    Else
        Err.Raise 1004
    End If
End Sub

hi fedjo

ups das vergass ich ja noch ^^

um eine fehlercodenummer zu erhalten schreibt man zur entwicklungszeit sein makro so das err auf dem bildschirm ausgegeben wird z.b. in eine nicht genutzte zelle

gruss nighty

hi fedjo :-)

du weisst ja mittlerweile das ich ein wirrkopf bin ^^

gruss nighty

Hallo nighty,
habe den Code noch mal überarbeitet (ohne Select ), aber ein Fachmann kann in bestimmt noch verbessern.

Gruß
fedjo


Sub Suchen()
'aktuelle KW suchen
Dim strSuch As Integer
strSuch = Sheets("Lieferzeiten").Range("A5").Value
lngAnz = WorksheetFunction.CountIf(Columns(3), strSuch)
Columns(3).Find(What:=strSuch, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Range("F2:F" & ActiveCell.Row + 3).Copy
Range("G2").PasteSpecial
Columns(3).Find(What:=strSuch, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Range("F2:F" & ActiveCell.Row + 3).ClearContents
End Sub

hi fedjo :-)

falls du noch tueffteln moechtest ^^

die findfunction nach´antwort 2 aufbauen ohne activate
dann koenntest du bei dieser zeile

Range("F2:F" & ActiveCell.Row + 3).ClearContents

auch das entfernen ActiveCell.Row

da du ja ueber

suche.Row
suche.Column

positionen bekommst

gruss nighty

Hi nighty,
ich danke dir noch mal für deine Unterstützung, du hast mir sehr geholfen mein Problem zu lösen.

Ich wünsche dir noch einen schönen Sonntag.

Gruß
fedjo