Rückmeldung von Hans an Reinhard

Hallo Reinhard, hallo Excelgemeinde,
Zuerst mal sorry Reinhard für`s späte Rückmelden (war leider ein Paar Tage nicht so auf der höhe), deshalb bedanke ich mich jetzt nochmal ganz herzlich bei Dir für Deinen untenstehenden Code zu diesem Thema hier
https://www.herber.de/forum/archiv/704to708/t706060.htm
Leider funktioniert er nur Teilweise, denn er überprüft nur jeweils die Zeile in die auch das Suchwort geschrieben wird.
Beispiel: In Blatt2 in Zeile H5 schreibe ich RA2 18", dann sucht er diesen Begriff auch nur im Blatt3 in Zeile L5, steht er nicht dort sagt er Fehler.
So sollte es sein: In Blatt2 in Zeile H5 schreibe ich RA2 18", dann soll er in
Blatt3 in Zeile L5 anfangen diesen Begriff zu suchen bis er auftaucht und dann die 6 nebenstehenden Zeilen in Blatt2 einzutragen.
Wird etwas in Blatt2 in Spalte H6 eingetragen, muss das Spielchen wider von vorne Anfangen.
Sollte der Begriff nicht auftauchen, dann erst Fehler.
Wichtig ist, das in Blatt3 die Datenbank ständig nach unten erweitert wird.
Option Explicit


Sub tt()
On Error GoTo Fehler 'falls nichts gefunden wird
Dim n As Integer, zei As Integer, ws As Worksheet
Set ws = Worksheets("Tabelle3")
ws.Activate
With Worksheets("Tabelle2")
For n = 5 To 50
If .Cells(n, 8) <> "" Then
zei = Application.WorksheetFunction.Match(.Cells(n, 8), ws.Range("L5:L8"), 0)
ws.Range(Cells(4 + zei, 13), Cells(4 + zei, 18)).Copy Destination:=.Cells(n, 9)
End If
Next n
.Activate
End With
Fehler:
MsgBox Worksheets("Tabelle2").Cells(n, 8) & " in Zeile " & n & " nicht gef"
End Sub

Vieleicht kannst Du Dir das nochmal anschauen oder es hat nochjemand eine Iddee
Gruss Hans

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hans,
probier mal so:

Sub Werte_suchen()
Dim wks1, wks2 As Worksheet
Dim HLetzte, i, kWertRow As Long
Dim kWert As String
Dim kWertX As Range
Set wks1 = Worksheets("Tabelle2")
Set wks2 = Worksheets("Tabelle3")
HLetzte = IIf(IsEmpty(wks1.Range("H65536")), wks1.Range("H65536").End(xlUp).Row, 65536)
For i = 5 To HLetzte
    kWert = wks1.Range("H" & i).Value
    With wks2
        Set kWertX = .Columns(12).Find(What:=kWert, lookat:=xlWhole)
        If Not kWertX Is Nothing Then
            kWertRow = kWertX.Row
            .Range("M" & kWertRow & ":R" & kWertRow).Copy wks1.Range("I" & i)
        Else
            wks1.Range("I" & i).Value = "Suchbegriff nicht gefunden!"
        End If
    End With
Next i
End Sub

Gruß aus Leipzig
P@ulchen

Beliebteste Forumthreads (12 Monate)

Rückmeldung von Hans an Reinhard

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread