Korrekte (oder inteligente) Syntax mit "with"
Peter
Mit nachfolgendem Code hole ich Daten in die Tabelle "Buchungstage", sortiere diese und eliminiere die Duplikate.
In der jetzigen Form funktioniert es. Allerdings wollte ich mit "with sheets("Buchungstage") arbeiten, damit der Code etwas strukturierter ist, was mir leider nicht gelang.
Im Weiteren gehe ich davon aus, dass die Tabelle aktiv sein muss. Ist dies nicht der Fall, bleibt der Code bei
With Sheets("Buchungstage").Range(Cells(Z1, 1), Cells(Z2, 1))
hängen.
Kann mir jemand dazu eine Hilfestellung geben?
Danke, Peter
Sub Doppelte_Loeschen()
Dim Z1 As Long, Z2 As Long, SP As Long, c As Range, Ende As Long, lngSpa As Long, Bereich As _
Range
'----Inhalt der Tabelle löschen und Daten zur Bearbeitung hineinkopieren
Sheets("Buchungstage").Cells.ClearContents
With Range("xBuchdat")
'Werte in Tabelle "Buchungstage"kopieren ab Zelle A2
.Copy Destination:=Sheets("Buchungstage").Range("A2")
End With
'------Position der hineinkopierten Daten bestimmen
Z1 = 2 '1. Zeile mit Daten
SP = 1 'Spalte
Z2 = Sheets("Buchungstage").Cells(65536, 1).End(xlUp).Row 'Letzte Zeile
'--- Hilfsspalten einfügen und Original-Reihenfolge sichern
Sheets("Buchungstage").Range("A:B").Insert
With Sheets("Buchungstage").Range(Cells(Z1, 1), Cells(Z2, 1))
.FormulaR1C1 = "=Row()"
.Formula = .Value
End With
'--- Doppelte kenzeichnen und loeschen
On Error Resume Next
With Sheets("Buchungstage").Range(Cells(Z1, 2), Cells(Z2, 2))
.EntireRow.Sort Key1:=Cells(Z1, SP + 2), Order1:=xlAscending, Header:=xlNo
.FormulaR1C1 = "=IF(RC[" & SP & "]=R[-1]C[" & SP & "],TRUE,RC[-1])" 'bei dieser _
Formel fliegen alle Null Werte raus
''.FormulaR1C1 = "=IF(EXACT(RC[" & SP & "],R[-1]C[" & SP & "]),TRUE,RC[-1])" 'bei _
dieser Formel bleibt ein Null-Wert, sofern vorhanden
.Formula = .Value
' .EntireRow.Sort Key1:=Cells(Z1, 2), Order1:=xlAscending, Header:=xlNo
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
End With
On Error GoTo 0
'--- Aufräumen
Sheets("Buchungstage").Range("A:B").Delete
Ende = Sheets("Buchungstage").Cells(65536, 1).End(xlUp).Row 'Letzte Zeile
'-----Range des verbleibenden Datenbereichs benennen
Set Bereich = Worksheets("Buchungstage").Range("A" & Z1, "A" & Ende)
ActiveWorkbook.Names.Add _
Name:="datExtrakt", _
RefersTo:=Bereich, Visible:=True
End Sub