Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Absturz in Excel 2007 (läuft in 2003 problemlos)
zurück: Adventskalender öffnen mit Zufallsauswahl weiter: Zugriff auf Access wenn Arbeitsgruppe+Datenbankpasswort Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
hurz
Im Profil kannst Du frei den Rang ändern


Verfasst am:
27. Nov 2008, 18:11
Rufname:

Absturz in  Excel 2007 (läuft in 2003 problemlos) - Absturz in Excel 2007 (läuft in 2003 problemlos)

Nach oben
       Version: Office 2007

Code:

Option Explicit

Public Sub Auswertung_generieren()
Dim Quelle As Range, Zeile As Range, Header As Range
Dim i As Long, j As Long
Dim WS As Worksheet, Ziel As Range
Dim OS As Worksheet
Dim Tabellen As Object, s As String, Eintrag As Variant

'erster durchlauf
Set Tabellen = CreateObject("Scripting.Dictionary")


With ThisWorkbook.Sheets(1)
    Set Quelle = .Range("A2:J" & .Range("B2").End(xlDown).Row)
End With
Set OS = ThisWorkbook.Sheets(1)
 
For Each Zeile In Quelle.Rows
    s = Trim(Zeile.Cells(1))
    If s <> "" Then
        If Tabellen.Exists(s) Then
            Set Tabellen(s) = Union(Tabellen(s), Zeile)
        Else
            Tabellen.Add s, Zeile
        End If
    End If
Next Zeile
 
For Each Eintrag In Tabellen.keys
Dim objXLSheet As Object
Dim pfad As String
pfad = "C:\test1\" & Eintrag
  On Error Resume Next
 
  Set objXLSheet = CreateObject("Excel.Sheet")


    With objXLSheet
        Set WS = .Sheets.Add
    End With
    On Error Resume Next
        WS.Name = Eintrag
    If Err.Number <> 0 Then
        Application.DisplayAlerts = False
            WS.Delete
        Application.DisplayAlerts = True
    End If: On Error GoTo 0

   
    Set WS = objXLSheet.Sheets(Eintrag)

    WS.Cells.ClearContents
   
       
    Set Ziel = WS.Range("A2")
    For Each Zeile In Tabellen(Eintrag).Rows
        Zeile.Copy
        Ziel.PasteSpecial xlPasteValues
        Ziel.PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        Set Ziel = Ziel.Offset(1, 0)
    Next Zeile
   
  OS.Range("A1:J1").Copy Destination:=WS.Range("A1")
  objXLSheet.SaveAs pfad
  objXLSheet.Application.[Quit]
  Set objXLSheet = Nothing

Next Eintrag
 
Tabellen.RemoveAll
Set Quelle = Nothing: Set Ziel = Nothing
Set Tabellen = Nothing: Set Eintrag = Nothing






'zweiter durchlauf
Set Tabellen = CreateObject("Scripting.Dictionary")


With ThisWorkbook.Sheets(1)
    Set Quelle = .Range("B2:J" & .Range("B2").End(xlDown).Row)
End With
Set OS = ThisWorkbook.Sheets(1)

For Each Zeile In Quelle.Rows
    s = Trim(Zeile.Cells(1))
    If s <> "" Then
        If Tabellen.Exists(s) Then
            Set Tabellen(s) = Union(Tabellen(s), Zeile)
        Else
            Tabellen.Add s, Zeile
        End If
    End If
Next Zeile


For Each Eintrag In Tabellen.keys


  pfad = "C:\test2\" & Eintrag
  On Error Resume Next

  Set objXLSheet = CreateObject("Excel.Sheet")


    With objXLSheet
        Set WS = .Sheets.Add
    End With
    On Error Resume Next
        WS.Name = Eintrag
    If Err.Number <> 0 Then
        Application.DisplayAlerts = False
            WS.Delete
        Application.DisplayAlerts = True
    End If: On Error GoTo 0


    Set WS = objXLSheet.Sheets(Eintrag)

    WS.Cells.ClearContents


    Set Ziel = WS.Range("A2")
    For Each Zeile In Tabellen(Eintrag).Rows
        Zeile.Copy
        Ziel.PasteSpecial xlPasteValues
        Ziel.PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        Set Ziel = Ziel.Offset(1, 0)
    Next Zeile

  OS.Range("B1:J1").Copy Destination:=WS.Range("A1")
  objXLSheet.SaveAs pfad
  objXLSheet.Application.[Quit]
  Set objXLSheet = Nothing

Next Eintrag

Tabellen.RemoveAll
Set Quelle = Nothing: Set Ziel = Nothing
Set Tabellen = Nothing: Set Eintrag = Nothing
Set WS = Nothing: Set Zeile = Nothing


End Sub


Kurz zur Funktionalität:

Eine Datei mit ganz vielen Einträgen
in Spalte A steht eine Person
in Spalte B steht eine andere Person
in Spalte C steht wieder eine andere Person

Person von Spalte A ist der ihr "nebenstehenden Person" (selbe Zeile Spalte B)
übergeordnet.

Ebenso ist Person Spalte B der Person in Spalte C übergeordnet.

Mein Code und guckt ist in Spalte A ein Eintrag, dann
wird das kopiert mit den ganzen Zellen die rechts daneben stehen.
Diese werden in eine neue Datei kopiert, die den Namen der Person trägt
und in einem Verzeichniss gespeichert
Dann kommt ein zweiter durchlauf für die Spalten B und C der ebenfalls
nachprüft ob in Spalte B was steht und wenn den davon rechts stehenden Text
in eine Datei kopiert mit dem Namen der Person aus Spalte B...

in Excel 2003 läuft er schön durch und erstellt in 2 ordnern ca. 60 dateien(je nach daten eben)
wenn ich das ganze mit Excel 2007 ausführe, dann stürzt Excel 2007 ab
und bring einen Speicherfehler :twisted:
"read" konnte nicht erfolgreich ausgeführt werden.

Ich bin absoluter neuling und hab mit copy und paste das ganze gefrickelt.

Beim Debugger kommt der fehler bei der zeile

Set objXLSheet = Nothing

falls ich diese auskommentiere

dann


Set objXLSheet = CreateObject("Excel.Sheet")

kommt hier der absturz


die erste datei erstellt es erfolgreich
sobald Set objXLSheet = CreateObject("Excel.Sheet")
zum zweiten mal aufgerufen wird, kommt der böse speicherfehler
und excel 2007 wird komplett geschlossen....


ich bin echt verzweifelt und wunder mich ziemlich

wahrs. is der code an sich nicht schön,
aber ich wäre sehr dankbar über tips!


vielen lieben dank!
gruß
hurz
r.mueller
Gast


Verfasst am:
27. Nov 2008, 20:02
Rufname:

AW: Absturz in  Excel 2007 (läuft in 2003 problemlos) - AW: Absturz in Excel 2007 (läuft in 2003 problemlos)

Nach oben
       Version: Office 2007

Hallo

Tja wenn du mit:

objXLSheet = CreateObject("Excel.Sheet")

Eine Funktionalität aus Excel4 Zeiten benutzt
Die seit Excel 5 nicht mehr unterstützt wird (aber noch geduldet).

Seit Excel 5 heist das Object: Workbook
also:

Code:
Set objXLSheet = Workbooks.Add


Gruß
r.mueller
hurz
Im Profil kannst Du frei den Rang ändern


Verfasst am:
27. Nov 2008, 21:02
Rufname:


AW: Absturz in  Excel 2007 (läuft in 2003 problemlos) - AW: Absturz in Excel 2007 (läuft in 2003 problemlos)

Nach oben
       Version: Office 2007

Danke!
wusst ich doch nicht, dass das aus excel 4 zeiten stammt :P
aber super vielen dank
hatte den weg auch schon mal eingeschlagen
aber dann öfter den fehler
objektvariable oder with-block nicht festgelegt
(hab die syntax eben 0 drauf)

denn in der späteren verwendung muss ich das ja alles ebenso anpassen :)

vielen lieben dank für den hinweis :)

gruß
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Wieviele Wenn-Ebenen bei Excel 2003? 2 Sven.Fischer 6962 29. Apr 2008, 06:51
< Peter > Wieviele Wenn-Ebenen bei Excel 2003?
Keine neuen Beiträge Excel Formeln: Excel 2003: Intervallüberschneidungen suchen 0 stefanmia 501 27. Apr 2008, 10:50
stefanmia Excel 2003: Intervallüberschneidungen suchen
Keine neuen Beiträge Excel Formeln: Berechnen von sin und cos mit excel 2003 4 City87 20800 13. Apr 2008, 11:09
riddler-rdl Berechnen von sin und cos mit excel 2003
Keine neuen Beiträge Excel Formeln: Kontrollkästchen in Excel 2007 2 schenzi 1806 07. März 2008, 11:04
schenzi Kontrollkästchen in Excel 2007
Keine neuen Beiträge Excel Formeln: Excel 2003 hilfe!!!! 2 Gast 1553 27. Feb 2008, 09:43
Gast Excel 2003 hilfe!!!!
Keine neuen Beiträge Excel Formeln: Excel 2003 Problem 1 Pauli 123 720 04. Feb 2008, 18:39
< Peter > Excel 2003 Problem
Keine neuen Beiträge Excel Formeln: Sonderzeichen ' Apostroph in Excel 2007 ersetzen 3 U2 Pas 4886 21. Nov 2007, 23:25
Gast Sonderzeichen ' Apostroph in Excel 2007 ersetzen
Keine neuen Beiträge Excel Formeln: Alter berechnen in Excel 2003 3 Gast 5102 28. Sep 2007, 10:37
Gast Alter berechnen in Excel 2003
Keine neuen Beiträge Excel Formeln: Makro aus Office 2003 2 Uwe100 643 16. Aug 2007, 13:43
Gast Makro aus Office 2003
Keine neuen Beiträge Excel Formeln: Preisvergleich - 3 Spalten - kompatibel zu Excel 2003 2 Gast 2231 07. Aug 2007, 14:03
vocke Preisvergleich - 3 Spalten - kompatibel zu Excel 2003
Keine neuen Beiträge Excel Formeln: Kalenderwoche berechnen mit Excel 2003 nicht mehr möglich? 1 heiko2 1653 02. Apr 2007, 09:06
< Peter > Kalenderwoche berechnen mit Excel 2003 nicht mehr möglich?
Keine neuen Beiträge Excel Formeln: Excel 2003: Summe innerhalb eines Zeitraums 8 SuchtFaktor 1497 29. März 2007, 21:55
SuchtFaktor Excel 2003: Summe innerhalb eines Zeitraums
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Project