Microsoft Excel

Herbers Excel/VBA-Archiv

Objekt erforderlich


Betrifft: Objekt erforderlich
von: Catha1996
Geschrieben am: 19.06.2017 10:57:14

Hallo liebe Forumsmitglieder,

ich habe folgenden Code, der eine Masterdatei nach Werten in Spalte F splitten soll, sodass mehrere kleine Excel-Dateien entstehen:

Sub LB_splitten()

Dim v As Object
Dim D As Object
Dim i As Long
Dim vFileToOpen As Variant
Dim Tool As Workbook
Dim GesÜbersicht As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String


     Application.ScreenUpdating = False
     
     
vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
     If Not IsArray(vFileToOpen) Then Exit Sub
     
     Set Tool = ActiveWorkbook
     Set GesÜbersicht = ActiveWorkbook.Worksheets.Item(1)
     
     CurrentFile = ActiveWorkbook.FullName
     
     NewFileType = "Excel Files 1997-2016 (*.xls), *.xls," & _
           "Excel Files 2007 (*.xlsx), *.xlsx," & _
           "All files (*.*), *.*"
           
     Set D = CreateObject("scripting.dictionary")

     With GesÜbersicht
         With .Range(Cells(1, 1), Cells(Rows.Count, 17)).CurrentRegion
             For Each v In .Columns(6).Offset(1).Value
                 If v <> "" Then D(v) = 0
             Next
             For Each v In D.Keys
               For i = Cells(Rows.Count, 6).End(xlUp).Row To 1 Step -1
                 If Cells(i, 6) <> v Then Rows(i).Delete
               Next i
 
               NewFile = Application.GetSaveAsFilename( _
                        InitialFileName:=v, _
                        fileFilter:=NewFileType)

               ActiveWorkbook.SaveAs Filename:=NewFile, _
                        FileFormat:=xlNormal, _
                        Password:="", _
                        WriteResPassword:="", _
                        ReadOnlyRecommended:=False, _
                        CreateBackup:=False

              Set ActBook = ActiveWorkbook
                Workbooks.Open CurrentFile
                ActBook.Close
              Next v
            End With
        End With
         
End Sub

In der Zeile
For Each v In .Columns(6).Offset(1).Value

wird mir allerdings angezeigt "Laufzeitfehler '424': Objekt erforderlich" und der Debugger zeigt an, dass v = 0 ist. Komischerweise habe ich diesen kompletten Absatz und auch die Deklarierung aus einem anderen Code übernommen, der ohne Probleme durchläuft.

Weiß jemand Rat?

Liebe Grüße
Catha

  

Betrifft: AW: Objekt erforderlich
von: Luschi
Geschrieben am: 19.06.2017 11:35:05

Hallo Catha,

For Each-Schleifen durchlaufen Excel-Objekte (hier Zellen), .Columns(6).Offset(1).Value liefert aber nur
die Werte des zu durchlaufenden Zellbereiches zurücvk und kann so überhapt nicht funktionieren.
Sicher ist das andere Projekt mit On Error-Anweisungen zugepflastert und der auch dort auftretende Fehler wird stillschweigend ignoriert.

Gruß von Luschi
aus klein-Paris


  

Betrifft: Luschi meint: .Value weglassen! orT
von: Luc:-?
Geschrieben am: 19.06.2017 13:47:07

Gruß, Luc :-?

Besser informiert mit …


  

Betrifft: Leider immer noch fehlerbehaftet
von: Catha1996
Geschrieben am: 20.06.2017 12:40:02

Danke an euch beide!

Allerdings beinhaltet mein anderer Code keine On Error-Anweisungen...

Sub WB_Planung_splitten()
'
' Tastenkombination: Strg+w
'
     Dim v, D As Object, wb As Workbook
     
     Application.ScreenUpdating = False
     
     Set D = CreateObject("scripting.dictionary")
     
     With Tabelle1
         With .Range("A1:R1200").CurrentRegion
             For Each v In .Columns(5).Offset(1).Value
                 If v <> "" Then D(v) = 0
             Next
             For Each v In D.Keys
                .AutoFilter 5, v
                If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                Set wb = Workbooks.Add(xlWBATWorksheet)
               .SpecialCells(xlCellTypeVisible).Copy
               wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteAll
               wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
               wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteValues
               wb.Worksheets(1).Cells(1).PasteSpecial Paste:=xlPasteFormulas
               With wb.Sheets(1)
                  .Name = v
                  .Cells.Font.Name = "Arial"
                  .Cells.Font.Size = 8
                  .Range("K2:O50").Locked = False
                  .Range("Q:Q").Locked = False
                  .Protect "wb"
              End With
             wb.SaveAs .Parent.Parent.Path & "\FK Tools" & "\" & v & ".xlsx", xlOpenXMLWorkbook
             wb.Close False
             End If
             Next
             .AutoFilter
         End With
     End With

     MsgBox "Finished!"

 End Sub
Und .Value weglassen bringt mich leider auch nicht wirklich weiter, da dann der gleiche Fehler zwei Zeilen weiter unten im Code auftritt.

Habt ihr noch andere Ideen woran es liegen könnte?

Gruß Catha


  

Betrifft: AW: Leider immer noch fehlerbehaftet
von: mmat
Geschrieben am: 20.06.2017 16:30:04

Hallo

.value einfach weglassen hilft nicht weiter, due willst ja verarbeiten, was da drinne steht.

Das .value muß in die nächste Zeile wandern:
If v.value <> "" Then D(v.value) = 0

Das gilt nätürlich überall. V ist ein Objekt, aber arbeiten tutst du mit der .value Eigenschaft desselbigen.

vg, MM


  

Betrifft: Das hatte ich nach Luschis Erläuterung ...
von: Luc:-?
Geschrieben am: 20.06.2017 19:37:15

…vorausgesetzt, denn v referenziert ja nun auf das Objekt, das diese Eigenschaft hat!
Luc :-?


  

Betrifft: Danke!
von: Catha1996
Geschrieben am: 21.06.2017 08:34:00

Vielen Dank, jetzt bin ich schon mal einen Schritt weiter :)

VG Catha


  

Betrifft: Danke!
von: Catha1996
Geschrieben am: 21.06.2017 10:04:50

Vielen Dank, jetzt bin ich schon mal einen Schritt weiter :)

VG Catha


  

Betrifft: AW: Objekt erforderlich
von: Catha1996
Geschrieben am: 21.06.2017 12:11:44

Hallo nochmal,

ich muss leider weiter nerven...

Ich habe den Code jetzt entsprechend geändert:

Sub LB_splitten()

Dim v As Object
Dim D As Object
Dim i As Long
Dim GesÜbersicht As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String


     Application.ScreenUpdating = False
     
     Set GesÜbersicht = ThisWorkbook.Worksheets.Item(1)
     
     CurrentFile = ThisWorkbook.FullName

     NewFileType = "Excel Files 1997-2016 (*.xls), *.xls," & _
           "Excel Files 2007 (*.xlsx), *.xlsx," & _
           "All files (*.*), *.*"
           
     Set D = CreateObject("scripting.dictionary")

     With GesÜbersicht
         With .Range(Cells(1, 1), Cells(Rows.Count, 17)).CurrentRegion
             For Each v In .Columns(6).Offset(1)
                 If v.Value <> "" Then D(v.Value) = 0
             Next v
             For Each v In D.Keys
               For i = Cells(Rows.Count, 6).End(xlUp).Row To 1 Step -1
                 If Cells(i, 6) <> v Then Rows(i).Delete
               Next i
          
               NewFile = Application.GetSaveAsFilename( _
                        InitialFileName:=v, _
                        fileFilter:=NewFileType)

               ActiveWorkbook.SaveAs Filename:=NewFile, _
                        FileFormat:=xlNormal, _
                        Password:="Era", _
                        WriteResPassword:="", _
                        ReadOnlyRecommended:=False, _
                        CreateBackup:=False

              Set ActBook = ActiveWorkbook
                Workbooks.Open CurrentFile
                ActBook.Close
              Next v
            End With
        End With
         
End Sub
Jetzt wird mir in der Zeile
 For Each v In D.Keys
wieder angezeigt "Objekt erforderlich" und wenn ich mit dem Cursor auf das v gehe, egal in welcher Zeile, steht überall "v = Nothing". Ich kann mir das nicht erklären, da die Tabelle gefüllt ist.

Ich hoffe jemand von euch kann mir nochmal helfen.

Gruß Catha


  

Betrifft: AW: Objekt erforderlich
von: Luschi
Geschrieben am: 21.06.2017 17:54:17

Hallo Catha,

schau mal hier: https://excelmacromastery.com/vba-dictionary/

Dim key As Variant
For Each key In dict.Keys
    Debug.Print key, dict(key)
Next key

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Objekt erforderlich
von: Catha1996
Geschrieben am: 22.06.2017 11:31:15

Hallo Luschi,

vielen Dank! Den Fehler hab ich jetzt auch ausgebügelt. Allerdings passiert jetzt gar nichts, wenn ich den Code ausführe :D

Sub LB_splitten()

Dim v As Variant
Dim D As Object
Dim i As Long
Dim GesÜbersicht As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String


     Application.ScreenUpdating = False
     
     Set GesÜbersicht = ThisWorkbook.Worksheets.Item(1)
     
     CurrentFile = ThisWorkbook.FullName

     NewFileType = "Excel Files 1997-2016 (*.xls), *.xls," & _
           "Excel Files 2007 (*.xlsx), *.xlsx," & _
           "All files (*.*), *.*"
           
     Set D = CreateObject("scripting.dictionary")

     With GesÜbersicht
         With .Range(Cells(1, 1), Cells(Rows.Count, 17)).CurrentRegion
             For Each v In .Columns(6).Offset(1)
                 If v.Value <> "" Then D(v.Value) = 0
             Next v
             For Each v In D.Keys
              Debug.Print v, D(v)
               For i = Cells(Rows.Count, 6).End(xlUp).Row To 1 Step -1
                 If Cells(i, 6) <> v Then Rows(i).Delete
               Next i
          
               NewFile = Application.GetSaveAsFilename( _
                        InitialFileName:=v, _
                        fileFilter:=NewFileType)

               ActiveWorkbook.SaveAs Filename:=NewFile, _
                        FileFormat:=xlNormal, _
                        Password:="Era", _
                        WriteResPassword:="", _
                        ReadOnlyRecommended:=False, _
                        CreateBackup:=False

              Set ActBook = ActiveWorkbook
                Workbooks.Open CurrentFile
                ActBook.Close
              Next v
            End With
        End With
         
End Sub
Hab ich den Code überhaupt richtig geändert?
LG Catha