Spaltensuche



Excel-Version: Exel 2000
nach unten

Betrifft: Spaltensuche
von: Andreas
Geschrieben am: 02.07.2002 - 17:36:41

Hollo,
wer kann mir helfen?
In zwei Tabellenblätter (Eingabe & Daten) soll die Spalte A durchsucht werden.
Wenn ein Wert in beiden Tabellenbätter vorhanden ist und gleichzeitig in Spalte D (Eingabe) ein Wert größer als "0" ist, soll die Zeile von dem Tabellenblatt "Daten" in ein neues Tabellenblatt (Gefunden) kopiert werden.
Danke Andreas



nach oben   nach unten

Re: Spaltensuche
von: Ramses
Geschrieben am: 02.07.2002 - 22:32:15

Hallo Andreas,

damit sollte es gehen:


Option Explicit
Sub Compare_And_Copy_Cells()
Dim Cr1 As Long, Cr2 As Long, Cr3 As Long
Dim i1 As Long, i2 As Long
Dim T1 As String, T2 As String, T3 As String
Dim As Excel.Range
'Tabellenvariablen füllen
T1 = "Eingabe"
T2 = "Daten"
T3 = "Gefunden"
'Letzte Leere Zeilen = Ende Datensätze finden
Cr1 = 65536
Cr2 = 65536
Cr3 = 65536
'Letzte Zelle in Tabelle T1 suchen
If Worksheets(T1).Cells(Cr1, 1) = "" Then
    Cr1 = Worksheets(T1).Cells(Cr1, 1).End(xlUp).Row
    Debug.Print Cr1
End If
'Letzte Zelle in Tabelle T2 suchen
If Worksheets(T2).Cells(Cr2, 1) = "" Then
    Cr2 = Worksheets(T2).Cells(Cr2, 1).End(xlUp).Row
    Debug.Print Cr2
End If
'Letzte Zelle in Tabelle T3 suchen
If Worksheets(T3).Cells(Cr3, 1) = "" Then
    Cr3 = Worksheets(T3).Cells(Cr3, 1).End(xlUp).Row
    Debug.Print Cr3
End If
'Vergleiche starten
With Worksheets(T2).Range("A:A")
    For i1 = 1 To Cr1
        Set z = .Find(Worksheets(T1).Cells(i1, 1), LookIn:=xlValues)
        If Not Is Nothing Then
            Worksheets(T1).Rows(i1).Copy Destination:=Worksheets(T3).Rows(Cr3)
            Cr3 = Cr3 + 1
        End If
    Next i1
End With
End Sub

Gruss Rainer

nach oben   nach unten

Re: Spaltensuche
von: Ándreas
Geschrieben am: 03.07.2002 - 17:33:01

Vielen Dank Rainer

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Einfügen einer Formel mit VBA"