ich hoffe ihr könnt mir bei einem Problem helfen, dass mich bis an den Rand der Verzweiflung gebracht hat.
Für eine Qualitätsprüfung werden Daten aus verschiedenen Checklisten-Dateien in ein Worksheet eingelesen (das funktioniert einwandfrei).
Dabei wird unter anderem die Kapitelnummer (Format 1.1.1 usw.) eingelesen und als Text formatiert in die entsprechende Spalte geschrieben. Text deshalb weil Excel mit sonst die Kapitel als Datumsangaben auswirft.
Wenn jetzt die Tabelle mit den Checklist-Daten nach Kapitelnummern sortiert werden soll, kommt der ärgerliche Fehler auf, dass Excel 1.1.10 direkt nach 1.1.1 sortiert.
Um das zu umgehen sollen mit einem anderen Makro nachdem die Checklisten eingelesen wurden die Kapitelnummern in eine Hilfstabelle auf einem anderen Datenblatt kopiert, wo sie mit TextToColumn aufgeschlüsselt werden, dann richtig als zahlen sortiert werden, eine Referenzliste bilden, nach den dann die Haupttabelle sortiert wird.
Ich hoffe es ist noch halbwegs verständlich.
Und genau dieses Sortier-Makro bereitet mir Probleme. Allerdings nicht, dass es nicht laufen würde, das funktioniert super und genau so wie gewünscht. Nur wenn das Makro gelaufen ist kann ich die Dateien nicht speichern, weil Excel dabei abstürzt.
Weder mit Speichern, Speichern unter... oder direktem Versuch die Excel-Datei direkt im Makro zu speichern kann ich verhindern, dass Excel abstürzt.
Ich habe in der Arbeit Windows 7 und Excel 2013. - Es stürzt ab.
Ein Kollege mit dem selben Setting. - Es stürzt ab.
Ein anderer Kollege mit Win10 und Excel 2013. - Es kann speichern dauert nur unverhältnismäßig lange.
Mein Rechner zuhause Win10 und Excel 2016. - Es stürzt ab.
Das andere Makro, zum Einlesen, das meiner Meinung nach wesentlich aufwändiger aufgebaut ist, macht keine Probleme. Das kann ich ausführen sooft ich will und speichern und alles.
Ich hoffe ihr könnt mir sagen, ob es irgendwo in meinem Code hakt, oder welche Ideen ihr sonst noch habt.
Vielen Dank schon mal und beste Grüße
Yvonne
Hier noch der Code:
Sub SortData()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Set wks1 = ThisWorkbook.Sheets("WKS1")
Set wks2 = ThisWorkbook.Sheets("WKS2")
' Kapitelnummern in Data-Kapitelsortierung kopieren
wks1.Activate
wks1.Range("DATA_KAP").Select
Selection.Copy
wks2.Activate
wks2.Range("SORTORDER").Select
Selection.PasteSpecial Paste:=xlPasteValues
' Kapitelnummern mit Text-zu-Spalte aufteilen
Selection.TextToColumns Destination:=wks2.Range("A3"), Other:=True, OtherChar:="."
' Leere Felder mit 0 auffüllen
wks2.Range("KAP_SORT").SpecialCells(xlCellTypeBlanks) = "0"
' Spalten Sortieren
wks2.Range("KAP_SORT").Sort key1:=Range("F2"), Header:=xlYes
wks2.Range("KAP_SORT").Sort key1:=Range("F2"), Header:=xlYes
wks2.Range("KAP_SORT").Sort key1:=Range("D2"), Header:=xlYes
wks2.Range("KAP_SORT").Sort key1:=Range("C2"), Header:=xlYes
wks2.Range("KAP_SORT").Sort key1:=Range("B2"), Header:=xlYes
wks2.Range("KAP_SORT").Sort key1:=Range("A2"), Header:=xlYes
' Sortierung in Array einlesen
Dim SortArray As Variant
SortArray = wks2.Range("SORTORDER")
wks2.Range("SORTORDER") = SortArray
' Kapitelnummern in Ursprungs-Liste Sortieren
Dim iListNum As Integer
Dim bAdded As Boolean
' Nummer von Kapitelsortierungs-Liste abfragen (falls diese schon besteht)
iListNum = Application.GetCustomListNum(SortArray)
' Wenn die Kapitelsortierung noch nicht besteht:
If iListNum = 0 Then
' Neue Liste für Sortierung erstellen
Application.AddCustomList SortArray
' Nummer der neuen Liste abfragen
iListNum = Application.CustomListCount
' Speichern, dass die neue Liste erstellt wurde
bAdded = True
End If
' Sortierung von neuer Liste anwenden
wks1.Activate
wks1.Range("DATA_KAP").Sort key1:=Range("D4"), ordercustom:=iListNum + 1, Header:=xlYes
' Zwischeneinträge und -ergebnisse löschen
' Die neue Liste
If bAdded Then Application.DeleteCustomList iListNum
' Die Einträge in der Kapitelsortierung
wks2.Activate
wks2.Range("KAP_SORT").Select
Selection.Delete
wks1.Activate
End Sub