Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1008to1012
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Probleme beim sortieren....

Probleme beim sortieren....
15.09.2008 17:10:39
Gordon
Moin,
ich habe hier ein kleines Problem mit dem Sortieren und VBA. Und zwar habe ich eine Datei, die ein Makro enthält. Wird das Makro ausgelöst, wird kurz darauf eine Datei geöffnet die sich im selben Ordner befindet und bis zu 10000 Datensätze enthält.
Ich wollte gerne, dass wenn die Datei mit den Datensätzen geöffnet wird, auch gleich eine Sortierung vorgenommen wird. Leider schmeßt er mir da immer eine Fehlermeldung raus mit de rich nichts anfangen kann. Die Hilfe gibt leider auch nichts her. Wenn ich die Sortirung weglasse, läuft das Makro sonst einwandfrei. Hier mal der Quellcode, der mir Sorgen macht:

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Datei, ReadOnly:=True
ActiveWorkbook.Sheets("Tabelle1").Range("A3:N10002").Sort Key1:=Range("M3"), Order1:= _
xlAscending, Key2:=Range("N3"), Order2:=xlAscending, Key3:=Range("A3"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


Sieht vielleicht jemand hier schon, woran es hapern könnte?
Gruß
Gordon

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Probleme beim sortieren....
15.09.2008 18:03:34
Tino
Hallo,
bei mir funktioniert es, versuche mal diese Version.
Modul Modul1
Option Explicit 
 
Sub Sortieren() 
Dim MeineDatei As Workbook 
Set MeineDatei = Workbooks.Open(ThisWorkbook.Path & "\" & Datei, , True) 
 
MeineDatei.Sheets("Tabelle1").Range("A3:N10002").Sort Key1:=Range("M3"), Order1:= _
    xlAscending, Key2:=Range("N3"), Order2:=xlAscending, Key3:=Range("A3"), _
    Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom 
 
End Sub 


Allerdings kenne ich Deine Datei nicht, eventuell liegt es an dieser (Aufbau, Tabellenschutz usw.…).
Gruß Tino

Anzeige
AW: Probleme beim sortieren....
15.09.2008 23:05:49
Gordon
Also das hat schon mal leider nicht geklappt. Bekomme immer diese Fehlermeldung:

Laufzeitfehler '1004':
Anwendungs- oder objektdefinierter Fehler


Hier mal etwas mehr von dem Code:


Sub Listen()
Dim i As Long, Anzahl As Long
Dim Datei As String, foo As String
Dim VZ$
Dim lngG As Long, lngT As Long, strAG As String, strN As String
Dim wksT As Worksheet
Application.DisplayAlerts = False
Application.EnableEvents = False
'Dateiname bestimmen
Datei = Worksheets("Listen erstellen").Range("e6").Value
If Worksheets("Listen erstellen").Range("e6").Value = "" Then
Datei = "Listengenerator_Original.xls"
End If
'Dateinnamen öffnen
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Datei, ReadOnly:=True
ActiveWorkbook.Sheets("Tabelle1").Range("A3:N10002").Sort Key1:=Range("M3"), Order1:= _
xlAscending, Key2:=Range("N3"), Order2:=xlAscending, Key3:=Range("A3"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Daten vom Original zum Generator übertragen
ThisWorkbook.Sheets("Generator").Range("a1:a10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("a3:a10002").Value
ThisWorkbook.Sheets("Generator").Range("b1:b10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("b3:b10002").Value
ThisWorkbook.Sheets("Generator").Range("c1:c10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("c3:c10002").Value
ThisWorkbook.Sheets("Generator").Range("d1:d10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("d3:d10002").Value
ThisWorkbook.Sheets("Generator").Range("e1:e10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("e3:e10002").Value
ThisWorkbook.Sheets("Generator").Range("j1:j10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("f3:f10002").Value
ThisWorkbook.Sheets("Generator").Range("k1:k10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("g3:g10002").Value
ThisWorkbook.Sheets("Generator").Range("l1:l10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("h3:h10002").Value
ThisWorkbook.Sheets("Generator").Range("m1:m10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("i3:i10002").Value
ThisWorkbook.Sheets("Generator").Range("n1:n10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("j3:j10002").Value
ThisWorkbook.Sheets("Generator").Range("o1:o10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("k3:k10002").Value
foo = ActiveWorkbook.Sheets("Tabelle1").Range("L2").Value
If foo = "Leistungsbereichs-Nr." Or foo = "Leistungsbereichs-Nummer" Or foo = " _
Leistungsbereichsnummer" Or foo = "Leistungsbereichsnr." Then
ThisWorkbook.Sheets("Generator").Range("p1:p10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("l3:l10002").Value
ThisWorkbook.Sheets("Generator").Range("q1:q10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("m3:m10002").Value
ThisWorkbook.Sheets("Generator").Range("r1:r10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("n3:n10002").Value
ThisWorkbook.Sheets("Generator").Range("s1:s10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("o3:o10002").Value
Else
ThisWorkbook.Sheets("Generator").Range("q1:q10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("l3:l10002").Value
ThisWorkbook.Sheets("Generator").Range("r1:r10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("m3:m10002").Value
ThisWorkbook.Sheets("Generator").Range("s1:s10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("n3:n10002").Value
End If
ActiveWorkbook.Close


Anzeige
AW: Probleme beim sortieren....
16.09.2008 08:30:00
David
Hallo Gordon,
mache doch die Sortierung einmal manuell und zeichne das mit dem Recorder auf, dann kannst du vergleichen.
Gruß
David
AW: Probleme beim sortieren....
16.09.2008 09:17:00
Gordon
Hab ich schon gemacht gehabt.
Leider hat das auch nichts geholfen.... :(
AW: Probleme beim sortieren....
16.09.2008 09:19:04
David
Kannst du die Datei (evtl. abgespeckt) hochladen, damit man das nachvollziehen kann?
Gruß
David
AW: Probleme beim sortieren....
16.09.2008 09:41:24
Gordon
Die Datei könnte ich schon hochladen, wobei ich das aber nicht mit der datei mit den Datensätzen machen kann. Datenschutz und so....
AW: Probleme beim sortieren....
16.09.2008 09:49:00
David
Ja nun, das kann man dadurch umgehen, dass man die Daten durch dummy-Daten ersetzt (deswegen auch das "abgespeckt"), es reichen ja ggf. auch 5 Zeilen oder so. Aber wenn man nicht die Möglichkeit hat, den Fehler zu reproduzieren, wird man dir wahrscheinlich auch nicht helfen können.
Gruß
David
Anzeige
AW: Probleme beim sortieren....
16.09.2008 14:27:15
Gordon
Ok,
habe mal die Datensatzdatei hochgeladen: https://www.herber.de/bbs/user/55434.zip
Die andere Datei, wo das Makro enthalten ist, konnte ich leider nicht hochladen, da diese zu groß war. Dafür hier nun der ganze Quellcode des Makros:

Option Explicit
Sub Listen()
Dim i As Long, Anzahl As Long
Dim Datei As String, foo As String
Dim VZ$
Dim lngG As Long, lngT As Long, strAG As String, strN As String
Dim wksT As Worksheet
Application.DisplayAlerts = False
Application.EnableEvents = False
'Dateiname bestimmen
Datei = Worksheets("Listen erstellen").Range("e6").Value
If Worksheets("Listen erstellen").Range("e6").Value = "" Then
Datei = "Listengenerator_Original.xls"
End If
'Dateinnamen öffnen
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Datei, ReadOnly:=True
ActiveWorkbook.Sheets("Tabelle1").Range("A3:N10002").Sort Key1:=Range("M3"), Order1:= _
xlAscending, Key2:=Range("N3"), Order2:=xlAscending, Key3:=Range("A3"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Daten vom Original zum Generator übertragen
ThisWorkbook.Sheets("Generator").Range("a1:a10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("a3:a10002").Value
ThisWorkbook.Sheets("Generator").Range("b1:b10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("b3:b10002").Value
ThisWorkbook.Sheets("Generator").Range("c1:c10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("c3:c10002").Value
ThisWorkbook.Sheets("Generator").Range("d1:d10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("d3:d10002").Value
ThisWorkbook.Sheets("Generator").Range("e1:e10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("e3:e10002").Value
ThisWorkbook.Sheets("Generator").Range("j1:j10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("f3:f10002").Value
ThisWorkbook.Sheets("Generator").Range("k1:k10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("g3:g10002").Value
ThisWorkbook.Sheets("Generator").Range("l1:l10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("h3:h10002").Value
ThisWorkbook.Sheets("Generator").Range("m1:m10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("i3:i10002").Value
ThisWorkbook.Sheets("Generator").Range("n1:n10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("j3:j10002").Value
ThisWorkbook.Sheets("Generator").Range("o1:o10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("k3:k10002").Value
foo = ActiveWorkbook.Sheets("Tabelle1").Range("L2").Value
If foo = "Leistungsbereichs-Nr." Or foo = "Leistungsbereichs-Nummer" Or foo = " _
Leistungsbereichsnummer" Or foo = "Leistungsbereichsnr." Then
ThisWorkbook.Sheets("Generator").Range("p1:p10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("l3:l10002").Value
ThisWorkbook.Sheets("Generator").Range("q1:q10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("m3:m10002").Value
ThisWorkbook.Sheets("Generator").Range("r1:r10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("n3:n10002").Value
ThisWorkbook.Sheets("Generator").Range("s1:s10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("o3:o10002").Value
Else
ThisWorkbook.Sheets("Generator").Range("q1:q10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("l3:l10002").Value
ThisWorkbook.Sheets("Generator").Range("r1:r10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("m3:m10002").Value
ThisWorkbook.Sheets("Generator").Range("s1:s10000").Value = ActiveWorkbook.Sheets("Tabelle1"). _
Range("n3:n10002").Value
End If
ActiveWorkbook.Close
'TN-Liste erstellen
Workbooks.Add
Anzahl = ActiveWorkbook.Sheets.Count
For i = 1 To Anzahl
Sheets("Tabelle" & i).Select
Select Case i
Case Is > 1
Sheets("Tabelle" & i).Select
ActiveWindow.SelectedSheets.Delete
End Select
Next i
'Daten übertragen von Generator zu TN-Liste
ActiveWorkbook.Sheets("Tabelle1").Range("1:1").Value = ThisWorkbook.Sheets("Format TN").Range(" _
1:1").Value
ActiveWorkbook.Sheets("Tabelle1").Range("a2:a10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("a1:a10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("b2:b10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("b1:b10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("c2:c10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("u1:u10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("d2:d10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("t1:t10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("e2:e10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("d1:d10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("f2:f10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("f1:f10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("g2:g10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("g1:g10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("h2:h10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("h1:h10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("j2:j10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("j1:j10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("k2:k10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("k1:k10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("l2:l10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("l1:l10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("m2:m10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("m1:m10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("n2:n10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("n1:n10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("o2:o10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("o1:o10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("p2:p10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("p1:p10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("q2:q10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("q1:q10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("r2:r10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("s1:s10000").Value
ActiveWorkbook.Sheets("Tabelle1").Range("s2:s10001").Value = "Bewerber/ MA/ TN ALLGEMEIN;  _
Teilnehmer HH Modell 2008"
ActiveWorkbook.Sheets("Tabelle1").Range("u2:u10001").Value = ThisWorkbook.Sheets("Generator"). _
Range("w1:w10000").Value
'TN-Liste formatieren und speichern
ActiveWorkbook.Sheets("Tabelle1").Cells.EntireColumn.AutoFit
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/" & Format(Date, "YYYY/MM/DD") & " _
_Listengenerator - TN.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ActiveWorkbook.Close
'Unternehmensliste erstellen
Workbooks.Add
Anzahl = ActiveWorkbook.Sheets.Count
For i = 1 To Anzahl
Sheets("Tabelle" & i).Select
Select Case i
Case Is > 1
Sheets("Tabelle" & i).Select
ActiveWindow.SelectedSheets.Delete
End Select
Next i
'Daten vom Generator zu Unternehmensliste übertragen
ActiveWorkbook.Sheets("Tabelle1").Range("1:1").Value = ThisWorkbook.Sheets("Format Unt").Range(" _
1:1").Value
ThisWorkbook.Sheets("Format Unt").Range("c2:c10001").Copy
ActiveWorkbook.Sheets("Tabelle1").Range("c2:c10001").PasteSpecial Paste:=xlFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Set wksT = ActiveWorkbook.Sheets("Tabelle1")
lngT = 1
With ThisWorkbook.Sheets("Generator")
Do While .Cells(lngG + 1, 1)  ""
lngG = lngG + 1
strAG = .Cells(lngG, 19)
strN = .Cells(lngG, 21)
lngT = lngT + 1
wksT.Cells(lngT, 2) = .Cells(lngG, 18).Value
wksT.Cells(lngT, 3) = strAG
wksT.Cells(lngT, 8) = "Unternehmen HH Modell 2008; Unternehmen ALLGEMEIN"
wksT.Cells(lngT, 10) = .Cells(lngG, 23).Value
Do While strAG = .Cells(lngG + 1, 19) And .Cells(lngG + 1, 1)  ""
lngG = lngG + 1
strN = strN & "; " & .Cells(lngG, 21)
Loop
wksT.Cells(lngT, 1) = strN
Loop
End With
'Unternehmensliste formatieren und speichern
ActiveWorkbook.Sheets("Tabelle1").Cells.EntireColumn.AutoFit
With ActiveWorkbook.Sheets("Tabelle1")
.Range("a2:j10001").Sort Key1:=.Range("C2"), Order1:=xlAscending, Key2:=.Range("B2"), Order2:= _
_
xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/" & Format(Date, "YYYY/MM/DD") & " _
_Listengenerator - Untern.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ActiveWorkbook.Close
'Endmeldung
MsgBox "Die beiden neuen Datein wurden erzeugt und liegen nun im Ordner: " & ThisWorkbook.Path & _
"\" & vbCrLf & vbCrLf & "Diese Datei schließt sich nun von selbst!"
'Ordner anzeigen und Excel schließen
VZ = ThisWorkbook.Path
Shell "Explorer " & VZ, vbNormalFocus
Application.Quit
End Sub


Anzeige
Nicht nachvollziehbar :-(
16.09.2008 16:00:29
Tino
Hallo,
habe mal das öffnen und Sortiermakro an deiner Gesamtliste.xls getestet.
Leider kann ich den Fehler nicht Nachvollziehen.
Nicht nachvollziehbar.
Modul Modul1
Option Explicit 
 
Sub Sortieren() 
Dim MeineDatei As Workbook 
Dim Datei As String 
Datei = "Gesamtliste.xls" 
 
Set MeineDatei = Workbooks.Open(ThisWorkbook.Path & "\" & Datei, , True) 
 
MeineDatei.Sheets("Tabelle1").Range("A3:N10002").Sort Key1:=Range("M3"), Order1:= _
    xlAscending, Key2:=Range("N3"), Order2:=xlAscending, Key3:=Range("A3"), _
    Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom 
 
End Sub 


Kann mir nur noch vorstellen, dass es an der Version liegt.
Zeichne Dir mal das Sortieren mit Deiner Version in der Gesamtliste.xls auf und schau mal ob es da Unterschiede gibt oder ersetzte diesen Codeteil am besten.
Gruß Tino

Anzeige
AW: Nicht nachvollziehbar :-(
16.09.2008 19:42:30
Gordon
Hatte ich schon gemacht...bekomme dennoch den Fehler.... :(
AW: Nicht nachvollziehbar :-(
16.09.2008 23:13:11
Original
Hi,
unzureichend referenziert, das funktioniert mit deinem Code nur, wenn das Blatt aktiviert ist.
mfg Kurt
AW: Nicht nachvollziehbar :-(
17.09.2008 10:31:00
Gordon
Ich glaube ich weiß was du meinst, aber hast du auch 'ne Idee wie ich das richtigen machen könnte? *lieb guck*
AW: Nicht nachvollziehbar :-(
17.09.2008 15:26:07
Original
Hi,
Option Explicit

Sub Sortieren()
Dim MeineDatei As Workbook
Dim Datei As String
Datei = "Gesamtliste.xls"
Set MeineDatei = Workbooks.Open(ThisWorkbook.Path & "\" & Datei, , True)
With MeineDatei.Sheets("Tabelle1")
.Range("A3:N10002").Sort Key1:=Range("M3"), Order1:= _
xlAscending, Key2:=Range("N3"), Order2:=xlAscending, Key3:=Range("A3"), _
Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End Sub


mfg Kurt

Anzeige
AW: Da waren ein paar Punkte weg...
17.09.2008 15:28:03
Original
Hi,
Option Explicit

Sub Sortieren()
Dim MeineDatei As Workbook
Dim Datei As String
Datei = "Gesamtliste.xls"
Set MeineDatei = Workbooks.Open(ThisWorkbook.Path & "\" & Datei, , True)
With MeineDatei.Sheets("Tabelle1")
.Range("A3:N10002").Sort Key1:=.Range("M3"), Order1:= _
xlAscending, Key2:=.Range("N3"), Order2:=xlAscending, Key3:=.Range("A3"), _
Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End Sub


mfg Kurt

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige