Excel VBA neuen Bereich zum sortieren übergeben

21/07/2009 - 12:07 von Erik Harren | Report spam
Moin!

Ich versuche mich gerade daran, eine aufgefüllte Tabelle nach dem Import
zu sortieren und anschl. die Dubletten zu entfernen. Irgendwie bin ich
dazu noch nciht in der Lage.

Bis dato ist mir untenstehendes dazu eingefallen bzw. entsprechend im
Netz gefunden. Vielleicht kann mir jemand hilfreich in die Seite treten.

Viele Grüße

Erik.

Sub Datenimport()
Dim Quelldatei, Zieldatei, dat As String
Dim Quelltabelle, Zieltabelle As Worksheet
Dim Quellzeile, Zielzeile As Range

Zieldatei = ActiveWorkbook.Name

dat = Workbooks.Application.GetOpenFilename("Exceldateien (*.xls),
*.xls")
'MeldungsDlg "Öffne " & dat
Quelldatei = dat

'Teil 1 - Grunddaten

Windows(Zieldatei).Activate
Sheets("Grunddaten").Select
Range("C65535").End(xlUp).Offset(1, 0).Select

Workbooks.Open Filename:=Quelldatei
Sheets("Grunddaten").Select
Range("C7:DM7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(Zieldatei).Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:= xlNone, SkipBlanks:=False, Transpose:=False

'Tabelle sortieren

'Dubletten entfernen
'Das wird überall gebraucht ggfs als Prozedur(en)

'Hier kommen dann noch weitere Einheiten, die folgendes gemeinsam
'haben:
' Erste Zelle in Zieltabelle = A3
' Zeilensortierung nach Spalte A
'Unterschiede:
' Spalten und Zeilenzahlen
END Sub

Sub TabelleSortieren(TabellenBereich As Range, Sortierspalte As Range)
Range(TabellenBereich).Select
Selection.Sort Key1:=Range(Sortierspalte), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub

Sub x()
' aus dem wunderbaren Indernett

Dim i As Long, lngRows As Long, rngSrc As Range

' Letzte Zeile aus Spalte O bestimmen
' Spalte O durch erste Spalte des Bereiches ersetzen
lngRows = IIf(Len(Cells(Rows.Count, 15)), Rows.Count, _
Cells(Rows.Count, 15).End(xlUp).Row)
' Den für Zàhlenwenn zu durchsuchenden Bereich in Spalte O definieren
' Spalte O durch erste Spalte des Bereiches ersetzen
' Zelle O1 durch erste Zelle des Bereiches ersetzen
Set rngSrc = Range("O1").Resize(lngRows)
' Zellen zum Löschen markieren, es kann hier nicht sofort gelöscht
werden, da der CountIf sonst bei
' der letzten 'doppelten' Zeile nur noch 1 wàre
'auch hier wieder Spalte O (15) durch erste Spalte (C od. A) des
Bereiches ersetzen
For i = lngRows To 1 Step -1
If WorksheetFunction.CountIf(rngSrc, Cells(i, 15).Value) > 1 Then
Cells(i, 1).Value = "DELME"
Next
' Zeilen löschen
For i = lngRows To 1 Step -1
If Cells(i, 1).Value = "DELME" Then Rows(i).Delete
Next
End Sub
 

Lesen sie die antworten

#1 Erik Harren
21/07/2009 - 17:17 | Warnen spam
Moin!

Erik Harren schrieb:
'Tabelle sortieren
'Dubletten entfernen
'Das wird überall gebraucht ggfs als Prozedur(en)



Hier versuche ich gerade mit:
'Tabelle sortieren

Range("C65535").End(xlUp).Select
Range(Selection, "C7:DM7").Select

'Range(Selection).Sort Key1:=Range("C7")

Range(("C6"), Cells(Rows.Count, 1).End(xlUp)).Sort _
Key1:=Range("C7"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom

'Dubletten entfernen
'Das wird überall gebraucht ggfs als Prozedur(en)

Range(("C7"), Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True

Die Markierung stimmt noch, allerdings klappt die Sortierung schon
nicht. Die anschließende .Advancedfilter funktioniert dementsprechend
auch nicht.

Hat jemand da einen Ansatz für mich?

Gruß,
Erik.

Ähnliche fragen