Makro einträgen aus tabelle kopieren und prüfen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Makro einträgen aus tabelle kopieren und prüfen
von: sebastian
Geschrieben am: 17.11.2015 09:35:42

Hallo zusammen, ich komme leider nicht weiter.
Ausgangsbasis:
Alle Einträge aus sheet "Antrieb" Spalte C soll in sheet "Beförderung" Spalte C kopiert werden (ans ende der liste), wenn der Eintrag dort noch nicht vorhanden ist.
Der Code:


Sub Übertrag_in_Beförderung()
 
 Dim EintragCheck1 As Variant
 Dim eintragCheck2 As Variant
 Dim EndeEintraegeBF
 Dim EndeEintraegeAN
 
 'Suche letzten Eintrag in jeweiligen sheet und Spalte 3 hier
 EndeEintraegeAN = Sheets("Antrieb").Cells(Rows.Count, 3).End(xlUp).Row
 EndeEintraegeBF = Sheets("Beförderung").Cells(Rows.Count, 3).End(xlUp).Row
 
 'EintragCheck1 = Sheets("Antrieb").Cells(1, 3).Value
 
 'Aktualisierung der Anzeige von Excel abgeschaltet, Durchlauf Schleifen nicht zu sehen
 Application.ScreenUpdating = False
 
 LeereZeile = EndeEintraegeBF + 1
 For j = 2 To EndeEintraegeAN
    EintragCheck1 = Sheets("Antrieb").Cells(j, 3).Value
    For i = 2 To EndeEintraegeBF
        eintragCheck2 = Sheets("Beförderung").Cells(i, 3).Value
        If EintragCheck1 <> eintragCheck2 Then
'hier drunter kommt was kopiert werden soll, wie wählt man Eintrag i aus zum kopieren?
            Sheets("Antrieb").Range("C" & i).Copy
'auswahl wohin kopiert werden soll funktioniert
            Sheets("Beförderung").Range("C" & LeereZeile).Select
            
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
            'Weder im Ausschneide- noch im Kopiermodus
            Application.CutCopyMode = False
            
            'neue letzte Zeile und nachfolgende berechnen
            EndeEintraegeBF = Sheets("Beförderung").Cells(Rows.Count, 1).End(xlUp).Row
            LeereZeile = EndeEintraegeBF + 1
            
            Else
            MsgBox "Eintrag schon vorhanden"
            Exit For
        End If
    Next i
 Next j
 
 'Aktualisierung der Anzeige von Excel abgeschaltet
 Application.ScreenUpdating = True
 
 End Sub

Leider wird aktuell immer nur der letzte Eintrag kopiert.
Wenn der Eintrag vorhanden ist soll er nichts kopieren und sich den nächsten Wert zum überprüfen schnappen.

Bild

Betrifft: AW: Makro einträgen aus tabelle kopieren und prüfen
von: Herbert Grom
Geschrieben am: 17.11.2015 13:07:45
Hallo Sebastian,
mit einer Beispieldatei wäre es einfacher.
Servus

Bild

Betrifft: AW Makro einträgen aus tabelle kopieren und prüfen
von: sebastian
Geschrieben am: 17.11.2015 13:33:31
Klar kein Problem, anbei die Datei.
https://www.herber.de/bbs/user/101589.xlsm
Bitte nur "Übertrag_in_Beförderung()" betrachten der Rest sind nur Spielereien von mir XD
Vielen dank schonmal :)

Bild

Betrifft: AW: AW Makro einträgen aus tabelle kopieren und prüfen
von: Herbert Grom
Geschrieben am: 17.11.2015 17:18:36
Hallo Sebastian,
versuche es mal damit:

Sub UebertragInBefoerderung()
   Dim EndeEintraegeAN&, EndeEintraegeBF&, lRow&, lSuchZahl&, lFindRow&
   
   '* Suche letzten Eintrag in der Spalte C:C im Sheet "Antrieb"
      EndeEintraegeAN = Sheets("Antrieb").Cells(Rows.Count, 3).End(xlUp).Row
      
   For lRow = 2 To EndeEintraegeAN
      EndeEintraegeBF = Sheets("Beförderung").Cells(Rows.Count, 3).End(xlUp).Row + 1
      lSuchZahl = Cells(lRow, 3).Value
      On Error Resume Next
      lFindRow = Sheets("Beförderung").Range("C:C").Find(What:=lSuchZahl, Lookat:=xlPart).Row
      If lFindRow > 1 Then GoTo jump
      Sheets("Beförderung").Cells(EndeEintraegeBF, 1).Value = Cells(lRow, 1)
      Sheets("Beförderung").Cells(EndeEintraegeBF, 2).Value = Cells(lRow, 2)
      Sheets("Beförderung").Cells(EndeEintraegeBF, 3).Value = lSuchZahl
jump:
      lFindRow = 0
   Next
End Sub
Servus

Bild

Betrifft: AW: AW
von: sebastian
Geschrieben am: 18.11.2015 08:41:39
Hallo Herbert,
leider passiert gar nichts, wenn ich das Makro von dir ausführe :-/
Am schönsten wäre es natürlich wenn mein Fehler gefunden werden könnte im Code oben. Denn ich muss sofern das funktioniert später noch weitere "Aktionen" in die innere For-schleife versuchen einzubauen.... aber noch hänge ich leider in der luft XD

Bild

Betrifft: AW: AW
von: Herbert Grom
Geschrieben am: 18.11.2015 11:20:49
Komisch, bei mir schon! Schau Dir mal die Datei an, da funktioniert es. Das Makro listet nun alle in Spalte C der Tab "Antrieb" nicht vorhandenen Zahlen in Spalte C der Tab "Beförderung" auf. Probiers mal mit meiner beigefügten AM aus.
https://www.herber.de/bbs/user/101608.xlsm
Servus

Bild

Betrifft: AW: AW
von: sebastian
Geschrieben am: 18.11.2015 12:46:31
Hmm stimmt, in der Datei funktioniert es... keine Ahnung warum es in meiner nicht geht!
Vielen dank schon mal! :)
Hast du vlt. bei meinem eigentlichen Code Fehler finden können warum dieser nicht soo arbeitet wie er soll (ich weiß, der ist länger aber für einen Anfänger wie mich leichter zu verstehen wenn es mehr zeilen sind :D)?!
Besten Gruß

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro einträgen aus tabelle kopieren und prüfen"