Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

plötzliche Laufzeitprobleme

Betrifft: plötzliche Laufzeitprobleme von: Andreas
Geschrieben am: 29.07.2020 15:28:05

Hallo liebe Forumer,

leider habe ich ein Problem was seit gerade auftritt. Bis dato hat der Codeschnipsel tadellos funktioniert.
Auch die Dateien haben sich nicht geändert. Vielleicht habt Ihr eine Idee woran das liegen könnte?

Der Code läuft sonst ohne Probleme durch. Habe im unten stehenden Code die Zeile ab der der Laufzeitfehler kommt fett markiert.

VIelen Dank schonmal vorab für eure Mühen.
Gruß
Andreas

Option Explicit

Public Sub Daten_Rechnungen_holen()
Dim wbQuelle As Workbook, wsQuelle As Worksheet
Dim strPfad As String, strBlattname As String
Dim loLetzte As Long, loSuchbegriff As Long
Dim boVorhanden As Boolean

'### Deinen Pfad hier anpassen #####
strPfad = "\\NAS-2T\fibu\"
'###################################
strBlattname = ActiveSheet.Name & " " & Right(Range("J3"), 2)
loSuchbegriff = ActiveSheet.Range("J1")

Application.ScreenUpdating = False

'Zielbereich leeren
With ActiveSheet
    loLetzte = .Cells(.Rows.Count, 15).End(xlUp).Row
    If loLetzte >= 4 Then
        .Range(.Cells(4, 15), .Cells(loLetzte, 20)).ClearContents
    End If
End With

'Datei Ausgangsrechnungen öffnen
Set wbQuelle = Workbooks.Open(strPfad & "Ausgangsrechnungen_rev2.7.xlsx")

With wbQuelle
    'richtiges Quellblatt wählen
    For Each wsQuelle In .Worksheets
        If wsQuelle.Name = strBlattname Then
            boVorhanden = True
            'Quellblatt nach Kostenstelle filtern
            With Worksheets(wsQuelle.Name)
                loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
                .Range("$A$4:$T$" & loLetzte).AutoFilter Field:=5, Criteria1:=loSuchbegriff
                loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
                If loLetzte < 5 Then
                    'MsgBox "Die gesuchte Kostenstelle ist nicht in Ausgangsrechnung vorhanden." _

                    If .AutoFilterMode Then
                        .ShowAllData
                        wbQuelle.Close (False)
                        Exit Sub
                    End If
                Else
                    'Filterergebnis kopieren
                    With .AutoFilter.Range
                        'Datum
                        .Resize(.Rows.Count - 1).Offset(1, 0).Columns(1).Copy
                        ThisWorkbook.ActiveSheet.Range("N9").PasteSpecial Paste:=xlPasteValues
                        'Kunde
                        .Resize(.Rows.Count - 1).Offset(1, 0).Columns(6).Copy
                        ThisWorkbook.ActiveSheet.Range("K9").PasteSpecial Paste:=xlPasteValues
                        'Betrag
                        .Resize(.Rows.Count - 1).Offset(1, 0).Columns(13).Copy
                        ThisWorkbook.ActiveSheet.Range("O9").PasteSpecial Paste:=xlPasteValues
                        'Typ
                        .Resize(.Rows.Count - 1).Offset(1, 0).Columns(2).Copy
                        ThisWorkbook.ActiveSheet.Range("L9").PasteSpecial Paste:=xlPasteValues
                        
                        
                        'SR
                        .Resize(.Rows.Count - 1).Offset(1, 0).Columns(3).Copy
                        ThisWorkbook.ActiveSheet.Range("P9").PasteSpecial Paste:=xlPasteValues
                        
                        'AR
                        .Resize(.Rows.Count - 1).Offset(1, 0).Columns(4).Copy
                        ThisWorkbook.ActiveSheet.Range("Q9").PasteSpecial Paste:=xlPasteValues
                        
                        
                            
                        
                        'RE-Nr. & AR-Nr.
                        '.Resize(.Rows.Count - 1).Offset(1, 0).Range(.Columns(3), _
                        .Columns(4)).Copy
                        'ThisWorkbook.ActiveSheet.Range("P9").PasteSpecial Paste:=xlPasteValues
                        
                        With ThisWorkbook.ActiveSheet
                            loLetzte = .Cells(.Rows.Count, 12).End(xlUp).Row
                           .Range(.Cells(9, 20), .Cells(loLetzte, 20)).FormulaLocal = _
                            "=WENN(P9<>"""";P9;Q9)"
                            .Range(.Cells(9, 20), .Cells(loLetzte, 20)).Copy
                            .Range("M9").PasteSpecial Paste:=xlPasteValues
                           .Range(.Cells(9, 16), .Cells(loLetzte, 20)).ClearContents
                        End With
                        'Quellblatt ohne speichern schließen
                        wbQuelle.Close (False)
                        Application.CutCopyMode = False
                    End With
                End If
            End With
            Exit For
        End If
    Next wsQuelle
End With

If Not boVorhanden Then
    'MsgBox "Es ist kein Tabellenblatt " & """" & strBlattname & """" & " in Ausgangsrechnung  _
vorhanden."
    wbQuelle.Close (False)
End If


Dim cell As Range

For Each cell In Columns(11).SpecialCells(xlCellTypeConstants, 1 + 2)
   With cell
      If IsEmpty(cell) = False Then
         .Offset(0, 3).NumberFormat = "DD.MM.YYYY" 'Format(Date, "General Date") Col N
         .Offset(0, 3).HorizontalAlignment = xlCenter
         .Offset(0, 4).Style = "Currency" 'Col O
         .Offset(0, 2).HorizontalAlignment = xlLeft
         With .Resize(, 5)
            .Interior.Color = RGB(217, 217, 217)
            .Font.Size = 12
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).Weight = xlMedium
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeRight).Weight = xlMedium
         
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
         End With
      End If
    End With
Next cell
      
Range("K1:O1").EntireColumn.AutoFit


Set wbQuelle = Nothing
Application.ScreenUpdating = True


End Sub

Betrifft: AW: plötzliche Laufzeitprobleme
von: Werner
Geschrieben am: 29.07.2020 15:37:09

Hallo,

und welcher Fehler denn? Das willst du uns nicht verraten?

Auf alle Fälle läuft der Code auf einen 1004 Fehler, wenn keine Daten in Spalte K (11) vorhanden sind.
Das wäre bei einer komplett leeren Spalte K der Fall.
Das selbe wäre der Fall, wenn die Werte in Spalte K durch eine Formel erzeugt werden. Das Ergebnis einer Formelberechnung ist nämlich auch keine "Konstante".

Gruß Werner

Betrifft: AW: plötzliche Laufzeitprobleme
von: Andreas
Geschrieben am: 29.07.2020 15:42:27

Hallo Werner,

danke für die Antwort. Sorry. Es gibt den Laufzeitfehler 1004 mit dem Hinweis keine Zellen gefunden.
In Spalte K sind keine Daten vorhanden, die werden im Code davor abgeholt bzw. wenn welche drin standen werden diese gelöscht. Bis dato hat es immer funktioniert.

Gruß Andreas

Betrifft: AW: plötzliche Laufzeitprobleme
von: Werner
Geschrieben am: 29.07.2020 15:55:21

Hallo,

was soll ich dazu jetzt sagen?
Du prüfst aber Spalte K = 11.

Wenn dort keine Daten vorhanden sind, weil die vorher gelöscht werden, weshalb prüfst du denn dann überhaupt Spalte K auf "Konstante".

Sorry aber hier hat niemand eine Ahnung davon was du machen willst. Kein Mensch kennt deine Datei und deren Aufbau.

Du prüfst die Spalte K auf das Vorhandensein von "Konstanten" und wenn die Spalte K leer ist dann gibt es halt diesen Fehler.

Gruß Werner

Betrifft: AW: plötzliche Laufzeitprobleme
von: Andreas
Geschrieben am: 29.07.2020 16:02:22

Hallo Werner,

ich habe leider nicht so viel Ahnung von VBA. Deshalb habe ich mit Hilfe des Forums den Code gebastelt.
Bis dato hat dies immer funktioniert. Leider kann ich die Datei nicht einfach einstellen, da hier Finanzdaten abgebildet werden. Mit dem Code über dem Laufzeitfehler werden in Spalte K Rechnungsdaten eingefügt.

Betrifft: AW: plötzliche Laufzeitprobleme
von: Daniel
Geschrieben am: 29.07.2020 15:39:55

Hi
wenn sich nichts geändert hat, gibt es auch keinen Grund, warum der Code nicht mehr funktionieren sollte.
wenns früher funktioniert hat und jetzt nicht mehr, muss sich was geändert haben.
was das ist, kannst nur du rausfinden.

du könntest uns, wenn du uns die Datei dazu nicht zeigen willst, zumindest mitteilen, WELCHER Laufzeitfehler denn auftritt.
die Art des Fehlers ist immer ein erster Hinweis auf eine mögliche Fehlerursache.

generell kann in der gezeigten Codezeile dann ein Fehler auftreten, wenn in der Spalte 11 keine konstanten Zahlen oder Texte enthält.

nur mal so als Anmerkung:
das "If IsEmpty(cell) = False Then" ist überflüssig, denn durch das von dir gewählte SpecialCells sind Leerzellen ja schon ausgeschlossen, darum brauchst du das nicht nochmal prüfen.

auffällig ist, dass du hier kein Workbook mehr angibst: For Each cell In Columns(11)

bist du sicher, dass auch das richtige tabellenblatt aktiv ist?
denn nur dann funktioniert der Code


Gruß Daniel

Betrifft: AW: plötzliche Laufzeitprobleme
von: Andreas
Geschrieben am: 29.07.2020 15:58:13

Hallo Daniel,

danke auch für deine Antwort. Laufzeitfehler ist 1004. Zellen nicht gefunden.
Ich habe hier tatsächlich nichts geändert. Es werden mit dem Code über dem Laufzeitfehler Daten aus einer Rechnungsliste geholt und ab Spalte K eingefügt. Sollte in Spalte K etwas drin stehen wird dies auch vorher gelöscht. Das Workbook wird auch im Code darüber wieder richtig angesprochen.

Gruß
Andreas

Betrifft: AW: Control it
von: Gerd L
Geschrieben am: 29.07.2020 15:59:34

Moin
If WorksheetFunction.CountA(Columns(11)) > 0 Then
For ..
...
Next
End If
Gruß Gerd

Betrifft: AW: Control it
von: Andreas
Geschrieben am: 29.07.2020 16:09:36

Hallo an euch 3,

es funktioniert wieder. Mein Kollege hat in der Datei wo die Rechnungsdaten geholt werden etwas geändert.........!

Danke trotzdem für eure Mühen.

Gruß
Andreas

Betrifft: AW: Control it
von: Daniel
Geschrieben am: 29.07.2020 16:36:00

Hattest du nicht eingangs geschrieben, dass die Daten NICHT verändert wurden?
Gruß Daniel

Betrifft: AW: ...Dateien... o.T.
von: Gerd L
Geschrieben am: 29.07.2020 16:58:41

.

Betrifft: AW: ...Dateien... o.T.
von: Andreas
Geschrieben am: 29.07.2020 17:08:09

Hallo Daniel,

an meiner Datei habe ich auch nichts geändert und der Kollege hat mir versichert auch nichts geändert zu haben.

Gruß Andreas