Herbers Excel/VBA-Archiv

Werte duplikatfrei übernehmen

• Werte duplikatfrei übernehmen von Markus vom 28.08.2014 14:28:10
• AW: Werte duplikatfrei übernehmen - von yummi am 28.08.2014 14:39:47
  • AW: Werte duplikatfrei übernehmen - von Markus am 28.08.2014 15:17:40
• AW: Werte duplikatfrei übernehmen - von Daniel am 28.08.2014 15:07:46
  • AW: Werte duplikatfrei übernehmen - von Markus am 28.08.2014 15:21:18
    • AW: Werte duplikatfrei übernehmen - von Daniel am 28.08.2014 15:27:55
    • AW: Werte duplikatfrei übernehmen - von Daniel am 28.08.2014 15:35:00
      • AW: Werte duplikatfrei übernehmen - von Markus am 01.09.2014 15:19:15

Betrifft: Werte duplikatfrei übernehmen von: Markus
Geschrieben am: 28.08.2014 14:28:10

Hallo Excel Forum!

Ich hänge mal wieder. Mit Makro 1 aus dem Archiv duchsuche ich im selben Sheet die Werte in Spalte A und schreibe nur einen eindeutigen Wert in Spalte N (wie Duplikate entfernen). Funktioniert ohne Probleme.
Dies wollte ich nun im zweiten Schritt diesbezüglich erweitern das dies auch über zwei Workbooks geschieht. Ich durchsuche im Workbook 1 Sheet 1 die Spalte A und schreibe jeden Wert den ich finde nur einmalig in Workbook 2 Sheet 2. Dies macht der Code nicht. Er schreibt alle Werte 1 zu 1 in meine Tabelle.
Was läuft hier schief? Ich komme einfach nicht drauf wo es genau hängt.

Hier das angepasste Makro:

Sub WertEinfach()
    'Kopiert alle Werte der Spalte A EINMALIG nach Spalte N - ohne Redundanzen
    Dim wksQ As Worksheet, wksZ As Worksheet
    'Dim wkbQ As Workbook, wkbZ As Workbook
    Dim lngZQ As Long, lngZZ As Long 'Zeilen-Variablen für Quelle/Ziel
    Dim lngSQ As Long, lngSZ As Long 'Spalten-Variablen für Quelle/Ziel
    
    lngSQ = 1 'Werte aus Quell-Spalte 1 = Spalte A
    lngSZ = 12 'Werte nach Ziel-Spalte 14 = Spalte N
    
    Set wksQ = ActiveWorkbook.Sheets("03_Monitoring")
    Set wksZ = Workbooks("Tool_Budget_Kakulation_Referenz.xlsm").Sheets("04_Monitoring_Neuteil") _

    wksZ.Range("L5:L4000").ClearContents 'Zielbereich löschen

    For lngZQ = 5 To wksQ.Cells(Rows.Count, lngSQ).End(xlUp).Row
        'Per ZÄHLENWENN() prüfen, ob Wert bereits in ZIEL-Spalte vorhanden ist :
        If wksZ.Application.WorksheetFunction.CountIf(Columns(lngSZ), wksQ.Cells(lngZQ, lngSQ))  _
= 0 Then
            'Wenn der Wert noch NICHT in der ZIEL-Spalte vorhanden ist :
            lngZZ = wksZ.Cells(Rows.Count, lngSZ).End(xlUp).Row + 1
            wksZ.Cells(lngZZ, lngSZ) = wksQ.Cells(lngZQ, lngSQ)
        End If
    Next
End Sub

Gruß
Markus

Betrifft: AW: Werte duplikatfrei übernehmen von: yummi
Geschrieben am: 28.08.2014 14:39:47

Hallo Markus,

du musst erst dein wkbQ und wkbZ setzen und dann damit die wksQ und wksZ

Set wkbQ = ActiveWorkbook
Set wkbZ = Workbooks("Tool_Budget_Kakulation_Referenz.xlsm")
Set wksQ = wkbQ.Sheets("03_Monitoring")
Set wksZ = wkbZ.Sheets("04_Monitoring_Neuteil")

Jetzt kannst Du deine Operationen mit wksQ und wksZ durchführen

Gruß
yummi

Betrifft: AW: Werte duplikatfrei übernehmen von: Markus
Geschrieben am: 28.08.2014 15:17:40

Habs eingebaut. Dachte es geht auch so wenn das Workbook und das sheet angegeben sind.
Leider kommt immer noch nicht das gewünschte Ergebnis. Es wird jede Zahl, ob doppelt oder nicht, geschrieben. Quasi eine 1 zu 1 Kopie.

Kann es sein das das ZählenWenn hier im Code nicht Workbook übergreifend funktioniert?

Ich hab mal Files hochgeladen. In der Hauptdatei soll der Vergleich durchgeführt werden.
In Spalte N mit dem Makro "Sub Werte_ohne_Redundanzen_Kopieren()" funktioniert es.
In Spalte L mit dem Makro "Sub WertEinfach()" wird nur kopiert. Siehe Vorlage.
https://www.herber.de/bbs/user/92364.xlsm = Haupdatei
https://www.herber.de/bbs/user/92365.xlsx = Nebendatei

In der Hauptdatei soll alles vereint werden.
Die Nebendatei wechselt immer.

Gruß
Markus

Betrifft: AW: Werte duplikatfrei übernehmen von: Daniel
Geschrieben am: 28.08.2014 15:07:46

Hi
warum so kompliziert?
Kopiere alles und lösche dann mit dem Duplikate entfernen die Duplikate raus.
Ist fürs Programmieren der geringste aufwand (im Optimalfall zwei Programmzeilen Copy_Destination und RemoveDuplicates) und auch im Ablauf das schnellste.

gruß Daniel

Betrifft: AW: Werte duplikatfrei übernehmen von: Markus
Geschrieben am: 28.08.2014 15:21:18

Stimmt. Des geht. Gibt halt nur einen Schönheitsfehler (mit dem man durchaus leben könnte) das die Zellformatierung auch gelöscht wird.
Mein Gedanke war halt hier mal nachzufragen ob es eine "Kleinigkeit" ist.
Wenn es größeren Aufwand bedeutet, dann müßßen alle mit dem Schönheitsfehler leben.

Gruß
Markus

Betrifft: AW: Werte duplikatfrei übernehmen von: Daniel
Geschrieben am: 28.08.2014 15:27:55

Hi
ok, bei Formatierungen ist das natürlich ein Problem.
das RemoveDuplicates ist auch deswegen so schnell, weil es auf solche "kleinigkeit" keine Rücksicht nimmt und sich auf die Daten konzentriert (dafür kannst du es aber auch in einer komplett befüllten Spalte mit 1,04 Mio Datensätzen anwenden)

hängt jetzt halt von deiner Datenmenge ab und vom Aufwand, die Formatierung wieder herzustellen, welche Variante die bessere ist.
ggf kanns auch sinnvoll sein, die Daten erstmal ohne Formatierung zu kopieren und diese dann übers Makro einzurichten.

Gruß Daniel

Betrifft: AW: Werte duplikatfrei übernehmen von: Daniel
Geschrieben am: 28.08.2014 15:35:00

Hi

dein ursprünglicher Code sollte natürlich auch funktionieren, wenn du die Daten zwischen zwei Workbooks kopierst.

du solltest halt nur darauf achten, dass du vor JEDEM Zellbezug (Cells, Range, Columns, Rows) jeweils Workbook und WorkSheet mit angibst bzw die entsprechnde Objektvariable.
fehlt diese Angabe so wie hier vor dem Columns:

If WorksheetFunction.CountIf(Columns(lngSZ), wksQ.Cells(lngZQ, lngSQ))= 0 Then

dann wird immer das aktive Workbook und Worksheet verwendet, somit besteht das Risiko, dass der Zellbezug auf dem falschen Blatt landet und falsche Ergebnisse liefert, weil du halt nicht sicher sein kannst, was jetzt tatsächlich aktiv ist.

Gruß Daniel

Betrifft: AW: Werte duplikatfrei übernehmen von: Markus
Geschrieben am: 01.09.2014 15:19:15

Hi Daniel,

dein Tipp war es.
If WorksheetFunction.CountIf(Columns(lngSZ), wksQ.Cells(lngZQ, lngSQ))= 0 Then
Das vor Columns auch was davor muss hatte ich wohl schlichtwegs übersehen.

Danke.
Gruß
Markus

Beiträge aus den Excel-Beispielen zum Thema "Werte duplikatfrei übernehmen"