Werte duplikatfrei übernehmen
28.08.2014 14:28:10
Markus
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
Markus