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
hallo andreas
ich kann dir helfen (oder ich versuch’s jedenfalls): das geht meiner meinug nach nur mit einem kleinen vba - makro:
du gehst zeile für zeile durch das eingabeblatt und schaust jeweils im datenblatt, ob der gleiche eintrag vorhanden ist. wenn er vorhanden ist und in spalte D ein wert grösser als 0 steht, kopierst du ihn in das andere tabellenblatt. probleme (dh längere wartezeiten) gibt es, wenn du in den tabellenblättern tausende von zeilen hast, ansonsten sollte es eigentlich gut funktionieren.
alles klar? wenn du möchtest kann ich dir auch ein makro schreiben und dann mailen.
grüsse
rolf
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Per Makro geht´s:
Option Explicit
Option Base 1
Const sAe As Integer = 1 ' Spalte A in Eingabe
Const sDe As Integer = 4 ' Spalte D in Eingabe
Const sAd As Integer = 1 ' Spalte A in Daten
Const sAg As Integer = 1 ' Spalte A in Gefunden
Const zMax As Long = 15
Const strEingabe As String = "Eingabe"
Const strDaten As String = "Daten"
Const strGefunden As String = "Gefunden"
Sub FindeGleichheit()
Dim zE As Long
Dim zD As Long
Dim WertE As Integer
Dim WertD As Integer
For zE = 1 To zMax
WertE = Sheets(strEingabe).Cells(zE, sAe).Value
If WertE = 0 Then
'Bei Null in Spalte A von Eingabe wird aufgehört.
MsgBox "Der Wert in Zelle (" & Chr(sAe + 64) & zE & ") ist Null (Blatt """ & strEingabe & """). Ende.", vbInformation, "Makro-Abbruch"
Exit For
Else
If Sheets(strEingabe).Cells(zE, sDe).Value \> 0 Then
'Nur bei \>0 in Spalte D werden die A-Spalten überhaupt verglichen.
For zD = 1 To zMax
WertD = Sheets(strDaten).Cells(zD, sAd).Value
If WertD = 0 Then
'Bei Null in Spalte A von Daten wird aufgehört.
'MsgBox "Der Wert in Zelle (" & Chr(sAd + 64) & zD & ") ist Null (Blatt """ & strDaten & """). Ende.", vbInformation, "Makro-Abbruch"
Exit For
Else
If WertE = WertD Then Call KopiereZeile(zD, strDaten, strGefunden, WertD, True)
End If 'WertD = 0
Next zD
End If 'Sheets(strEingabe).Cells(zE, sAD).Value \> 0
End If 'Sheets(strEingabe).Cells(zE, sAD).Value = 0
Next zE
MsgBox "Fertig.", vbInformation, "Zeilen kopieren"
End Sub 'FindeGleichheit
Sub KopiereZeile(lngZeile As Long, strVon As String, strNach As String, Optional intWert As Integer, Optional booMeldung As Boolean)
Dim z As Long
For z = 1 To zMax
If Sheets(strGefunden).Cells(z, sAg).Value = 0 Then Exit For
Next z
If booMeldung Then MsgBox "Kopiere Zeile " & lngZeile & " (" & Chr(sAd + 64) & lngZeile & " = " & intWert & ") vom Blatt """ & strVon & """ in Zeile " & z & " des Blattes """ & strNach & """.", vbInformation, "Kopiere Zeile ..."
Sheets(strDaten).Rows(lngZeile).Copy
Sheets(strGefunden).Activate
Sheets(strGefunden).Cells(z, sAd).Activate
Sheets(strGefunden).Paste
End Sub 'KopiereZeile
Kopiere das alles in ein leeres Modul in Deiner Excel-Datei, ändere die Namen der Tabellenblätter entsprechend und probiere es mal aus.
Ich hoffe, ich habe Dein Problem richtig verstanden. Bei Fragen bitte melden. Ist immer so´ne Sache mit fertigen Makros.
Kristian
Und, geht´s? - k.T. -
k.T.
Möchte nur wissen, ob das Makro was gebrahct hat.