Clever-Excel-Forum

Hallo ich habe folgendes Problemchen, so sieht ungefähr meine Tabelle aus:

SpalteA.......SpalteB
GKZ..........Typ

7W08.........Art 1 Z ohne R
7W23.........Art 1 Z ohne R
7S09.........Art 1 Z ohne R
7S73.........Art 1 Z ohne R
7S99.........Art 1 Z ohne R
7W23.........Art 2 X mit R

in der Zelle E1 wird der gesuchte Wert eingeben und in F1 wieder der zugehörige Typ ausgegeben.
Meine Suchfunktion funktioniert soweit das wenn der gesuchte Wert gefunden wurde der Typ ausgegeben wird. Jedoch kommt in SpalteA 7W23 zweimal vor, ich möchte aber folgende Ausgabe:
Wenn nach 7W23 gesucht wird soll der Typ in der Spalte F untereinander aufgelistet werden
7W23 Art1 Z ohne R
Art 2 X mit R

Mein Code:

Code:
Sub ZeileFinden()

Dim Ergebnis As Range

Set Ergebnis = Tabelle1.Columns(1).Find(what:=Tabelle1.Range("E1").Value, _

                lookat:=xlWhole)

If Ergebnis Is Nothing Then

MsgBox "Leider nichts gefunden"

Else

Tabelle1.Range("F1").Value = Tabelle1.Cells(Ergebnis.Row, 2).Value

End If

End Sub

Ich hoffe es kan mir jemand dabei weiterhelfen Blush

Danke

claudia

Hallo Claudia,

in diesem Fall musst Du die FindNext Methode nutzen. Ist in der Excel Hilfe knapp beschrieben.

So sollte es gehen:

Code:
Option Explicit

Sub ZeileFinden()

   Dim i As Long

   Dim Ergebnis As Range

   Dim strgAddress As String

   With Tabelle1.Columns(1)

      .Columns(6).ClearContents  'Spalte F wird zuerst geleert

      Set Ergebnis = .Find(what:=Tabelle1.Range("E1").Value, _

                   lookat:=xlWhole)

      If Not Ergebnis Is Nothing Then

         strgAddress = Ergebnis.Address

         Do

            i = i + 1

            Tabelle1.Range("F" & i).Value = Tabelle1.Cells(Ergebnis.Row, 2).Value

            Set Ergebnis = .FindNext(Ergebnis)

         Loop While Not Ergebnis Is Nothing And Ergebnis.Address <> strgAddress

      Else

         MsgBox "Leider nichts gefunden"

      End If

   End With

End Sub

Bei größeren Datenbeständen eignet sich der Spezialfilter besser.

Perfekt Dankeeeeeee :23:

Hallo Claudia,

probier es mal so:

Code:
Sub Suche()

Dim i As Long

Dim ZeileMax As Long

Dim Treffer As Range

Dim strBegriff As String

With Tabelle1

strBegriff = .Range("E1").Value

Set Treffer = .Range("A2")

.Columns(6).ClearContents

ZeileMax = .Cells(Rows.Count, 6).End(xlUp).Row

For i = 1 To WorksheetFunction.CountIf(Columns(1), strBegriff)

    Set Treffer = Columns(1).Find(What:=strBegriff, After:=Treffer, _

                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _

                SearchDirection:=xlNext, MatchCase:=False)

    If Not Treffer Is Nothing Then

        Treffer.Offset(0, 1).Copy Destination:=Range("F" & ZeileMax)

        ZeileMax = ZeileMax + 1

    End If

Next i

End With

End Sub

Gruß
Max

claudia

atilla

claudia

Max