hi afetinci ^^

fuer die suchfunktion ein beispiel

gruss nighty

folgende ausgangsposition

Worksheets(1)
A1 eingabe
A2 bis letzte genutzte zeile als suchbereich
kopiert werden zur zeit die ersten 10 spalten einer zeile bei fund

Worksheets(2)
ausgabe zur ersten freien zeile

einzufuegen
alt+f11/projektexplorer/DeineTabelle

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row = 1 And Target.Column = 1 Then
    Dim suche As Range
    Set suche = Worksheets(1).Range("A2:A" & Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Find(Worksheets(1).Cells(1, 1))
    If Not suche Is Nothing Then
        Worksheets(1).Range(Worksheets(1).Cells(suche.Row, 1), Worksheets(1).Cells(suche.Row, 10)).Copy _
            Worksheets(2).Range(Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1), Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 10))
    End If
End If
Application.EnableEvents = True
End Sub

Hallo,

ob ich Dir wirklich helfen kann, weiß ich noch nicht, da meine VBA-Kenntnisse auch auf einem unterem Level sind.

Was ich allerdings nicht verstanden habe ist der nachstehende Satz in Deiner Anfrage:

Ist es möglich auch eine "Suchoption" in Excel einzupflegen, wo ich in einer Zelle den Namen eingebe und in einem anderen Tabellenblatt die Werte wiedergegeben werden (10 Eingaben sollten möglich sein).

Was meinst Du mit den 10 Eingaben in einer Zelle ???

Meinst Du in einer Zelle z.B. A1 wird ein Name eingetragen -
dann wird nach dem Namen gesucht und die gefundenen Daten zu dem Namen in das andere Tabellenblatt übertragen und Zelle A1 anschließend wieder löschen und Du könntest dann einen neuen Namen eintragen und der Vorgang wiederholt sich so oft Du einen neuen Namen einträgst oder
möchtest Du einen Bereich von 10 Zellen als Vorgabe machen z.B. A1 : A10 und die dort befindlichen Namen werden dann durchsucht unf übertragen oder meinzest Du es noch anders?

In diesem Sinne.... have a nice Day... Gruß Helmut

ok...
meine Anfrage hat sich da wohl bereits erledigt.... ;-)

Gruß Helmut

vielen Dank für die schnellen Antworten.

Mit 10 habe ich 10 Sucheingaben gemeint. Der Code hilft mir schon einen Teil weiter. Wie ist es, wenn zwei Namen gleich sind?? Kann man da auch was machen??, Das mir erst ein Fenster oder eine Auswahlbox angezeigt wird, wo ich den richtigen wählen kann, ist so etwas möglich???

Danke nochmal!!

hi afetinc ^^

ich werd mich dann wohl doch mal an eine userform wagen :-))

schick mir eine mustertabelle zu,damit ich den aufbau der daten hab

und deine konkreten wuensche angeben bitte,lieber zu viel als zu wenig :-))

gruss nighty

oberley@t-online.de bitte mit eindeutigen betreff

Hi nighty,

vielen Dank für deine Hilfe:-)

Mit dem ersten Code komme ich sehr gut voran. Ich kann mit diesem auch weiterarbeiten.

Mein Problem ist nur noch:

wenn sich zwei Bewerber mit dem selben Namen in der Liste befinden.
Wie kann ich suchen, dass mir beide angezeigt werden und ich dann einen von diesen auswählen kann, der sich dann in dem anderen Tabellenblatt kopiert.

Ich bräuchte also zu deinem Code nur noch eine Zwischenanzeige (Auswahlbox??) wo ich dann den richtigen Bewerber auswählen kann sofern sich zwei gleiche in der Liste befinen. Ich weiß es ist viel verlangt.

Gruß
afetinci :-)))))

hi afetinci ^^

schon mal mit mehrfach fund

auswahl muss ich mir noch gedanken machen :-)

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Row = 1 And Target.Column = 1 Then
        Dim suche As Range
        For zaehler = 1 To Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
            Set suche = Worksheets(1).Range("A" & zaehler & ":A" & Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Find(Worksheets(1).Cells(1, 1))
            If Not suche Is Nothing Then
                zaehler = suche.Row
                Worksheets(1).Range(Worksheets(1).Cells(suche.Row, 1), Worksheets(1).Cells(suche.Row, 10)).Copy _
                    Worksheets(2).Range(Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1), Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 10))
            Else
                Exit For
            End If
        Next zaehler
    End If
    Application.EnableEvents = True
End Sub

hi afetinci ^^

ups fehlte ja eine deklaration einer var

das zweite makro dient deinen experimenten,um bei halt des makros das ereignis wieder zu aktivieren

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Row = 1 And Target.Column = 1 Then
        Dim suche As Range
        Dim zaehler As Long
        For zaehler = 1 To Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
            Set suche = Worksheets(1).Range("A" & zaehler & ":A" & Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Find(Worksheets(1).Cells(1, 1))
            If Not suche Is Nothing Then
                zaehler = suche.Row
                Worksheets(1).Range(Worksheets(1).Cells(suche.Row, 1), Worksheets(1).Cells(suche.Row, 10)).Copy _
                    Worksheets(2).Range(Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1), Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 10))
            Else
                Exit For
            End If
        Next zaehler
    End If
    Application.EnableEvents = True
End Sub

Sub EreignissOn()
    Application.EnableEvents = True
End Sub

Hi nighty,

du bist mir eine wirklich große Hilfe. Ich danke dir für die Codes, bin schon fast Fertig mit der Tabelle.

Eine einzige Frage hätte ich noch:
Ich möchte, dass wenn ich im Bereich (Spalte A1:A800) klicke (nur Klicke), mir in Spalte B der wert 1 wiedergegeben wird.

Ich kriege es so schon fast hin, nur weis ich nicht wie ich den Code schreiben soll, dass er sich automatisch auf die nächsten Zeilen kopiert, d.h. wenn ich z.B. Zeiel A5 klicke mir der Wert dementsprechend in Spalte B5 wiedergegeben wird.

Gruß
afetinci

hi afetinci ^^

auf eine ereignisroutine bezogen,ein beispiel

gruss nighty

click auf den angegebenen bereich,uebergabe des wertes zur spalte b bzw wenn du eine 1 wolltest ersetze den code hinter dem gleichheitszeichen durch die 1

einzufuegen
alt+f11/projektexplorer/DeineTabelle

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If Selection.Count < 2 Then
        If Not Intersect(ActiveCell, Range("A1:A800")) Is Nothing Then
            Worksheets(1).Cells(Target.Row, Target.Column + 1) = Worksheets(1).Cells(Target.Row, Target.Column).Value2
        End If
    End If
    Application.EnableEvents = False
End Sub

hi all ^^

ups , vorletzte zeile bitte auf true :-)

gruss nighty

hi all ^^

also irgend ein fehler ist wohl immer da,ich glaub ich hatte noch nie ein fehlerfreies makro,das sollte zu denken geben *gruebel gruebel*

ich habs rausgefunden :-)

nennt sich das nighty syndrom *grrr*

gruss nighty

Hi Nighty,

ich hoffe ich stresse dich nicht rein :-). Leider konnte ich dir nicht antworten, da ich am wochenende nicht hier war. Die Makros haben bis jetzt fehlerfrei funktioniert :-)))) Also bist super.

Dein Makro überträgt mir den Wert von Spalte A nach Spalte B beim klicken. Vielleicht konnte ich das nicht gut erklären:

Ich benötige ein Code, dass wenn ich irgendwo (Zeile 1:800) auf Spalte A klicke mir in Spalte B in derselben Zeile wie A der Wert 1 eingetragen wird.

Gruß und vielen Dank für deine Mühen.

afetinci

Hallo afetinci,
mit einem Doppel Klick:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("A1:A800")
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Offset(0, 1) = 1
End If
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub

Oder

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("A1:A800")
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Offset(0, 1) = 1
End If
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub

Gruß
fedjo

Hallo Fedjo,

vielen Dank für den Code. So soll er funktionieren. Kann man aber anstelle Doppel Klick nur einen Klick machen??

Gruß

Hi Fedjo,

Besten Dank für deine Mühen!!!
klappt super!!!

Gruß
afetinci