Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
24.04.2024 14:40:10
Zeilenumbrüche in Textbox zählen
24.04.2024 14:06:20
Gesamte Column löschen, wenn Column-Bereich leer
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1792to1796
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1792to1796
1792to1796
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Verzweifelte Fehlersuche

Verzweifelte Fehlersuche
11.11.2020 14:54:49
Lizzel
Hallo zusammen,
ich habe zwei Themen wo ich einfach den Fehler nicht finde:
1.) Ich verstehe nicht, warum er für dem ersten IF nicht das passende ELSE zu ordnen kann
 If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(2), Zelle1.Value) > 0 Then

 Else: MsgBox "Kein Verantwortung vorhanden"
End If

2.) Mit CountIf schaue ich ob ein Wert vorhanden ist und dann soll die Schleife durchlaufen. Aber er durchläuft die Schleife trotzdem, obwohl kein Wert da ist.
 If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(5), Zelle2.Value) > 0 Then


Dim Zelle1 As Range              'Für die Filterung
Dim Zelle2 As Range
Dim Nummernkreis As String
' Nach Verantwortung filtern (E, M und E/M)
For Each Zelle1 In Range("Kriterien")
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=1, Criteria1:=Zelle1.Value
' Nach Intervall filtern
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(2), Zelle1.Value) > 0 Then
For Each Zelle2 In Range("Intervall")
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(5), Zelle2.Value) > 0   _
_
Then
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=4, Criteria1:=Zelle2.Value
Worksheets("Wartungskarte").Copy
Nummernkreis = InputBox("Bitte Nummernkreis eingeben:")
Range("B7").Value = Nummernkreis
Else: MsgBox "Kein Intevall vorhanden"
End If
Else: MsgBox "Kein Verantwortung vorhanden"
End If

Danke
Gruß Lars

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verzweifelte Fehlersuche
11.11.2020 15:43:17
Luschi
Hallo Lars,
jedes 'For' bedarf eines abschließenden 'Next'; davon ist aber im Code nix zu entdecken.
Aber auch die Fehleranzeige des Debuggers ist eben nicht perfekt und irrt sich schon mal.
Gruß von Luschi
aus klein-Paris
AW: Verzweifelte Fehlersuche
11.11.2020 16:00:51
Lizzel 

Dim Zelle1 As Range              'Für die Filterung
Dim Zelle2 As Range
Dim Nummernkreis As String
' Nach Verantwortung filtern (E, M und E/M)
For Each Zelle1 In Range("Kriterien")
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=1, Criteria1:=Zelle1.Value
' Nach Intervall filtern
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(2), Zelle1.Value) > 0 Then
For Each Zelle2 In Range("Intervall")
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(5), Zelle2.Value) > 0  _
Then
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=4, Criteria1:=Zelle2.Value
Worksheets("Wartungskarte").Copy
Nummernkreis = InputBox("Bitte Nummernkreis eingeben:")
Range("B7").Value = Nummernkreis
Else: MsgBox "Kein Intevall vorhanden"
End If
'Else: MsgBox "Kein Verantwortung vorhanden"
End If
'Durch den Filter ausgeblendete Zeilen löschen
Dim rng As Range
Dim lastrow As Long
Dim l As Long
Application.ScreenUpdating = False
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If lastrow > 1 Then
For l = lastrow To 1 Step -1
If Range("A" & l).EntireRow.Hidden Then
Range("A" & l).EntireRow.Delete
End If
Next l
End If
Application.ScreenUpdating = True
' Nach Intervall sortieren
'ActiveWorkbook.Worksheets("Wartungskarte").ListObjects("Tabelle1").Sort. _
'      SortFields.Clear
'  ActiveWorkbook.Worksheets("Wartungskarte").ListObjects("Tabelle1").Sort. _
'      SortFields.Add Key:=Range("Tabelle1[[#All],[Wartungsintervall]]"), SortOn:= _
'      xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'  With ActiveWorkbook.Worksheets("Wartungskarte").ListObjects("Tabelle1").Sort
'      .Header = xlYes
'      .MatchCase = False
'     .Orientation = xlTopToBottom
'     .SortMethod = xlPinYin
'      .Apply
'  End With
' Nummeriert die Aufgaben durch
Dim x As Long, n As Long
n = 10
With Sheets("Wartungskarte")
For x = 30 To .Cells(Rows.Count, "G").End(xlUp).Row
If .Cells(x, "G")  "" Then
.Cells(x, "A") = n
n = n + 10
End If
Next
End With
' gefilterte Tabelle öffnen, umbennen, speichern und schließen
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\F5GDI4W\Documents\Wartungskarten\Vorlage" & "\" & Nummernkreis, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
Next
Next
'"C:\Users\F5GDI4W\Documents\Wartungskarten\Vorlage"
Unload Me
End Sub
Hier mal der komplette Teil. Wenn ich mich nicht verzählt habe, habe ich für jeden For ein Next
Anzeige
AW: Verzweifelte Fehlersuche
11.11.2020 16:40:44
peterk
Hallo
Mit !!!! markiert

Sub rtt()
Dim Zelle1 As Range              'Für die Filterung
Dim Zelle2 As Range
Dim Nummernkreis As String
' Nach Verantwortung filtern (E, M und E/M)
For Each Zelle1 In Range("Kriterien")
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=1, Criteria1:=Zelle1.Value
' Nach Intervall filtern
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(2), Zelle1.Value) > 0  _
Then
For Each Zelle2 In Range("Intervall")
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(5), Zelle2. _
Value) > 0 Then
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=4, Criteria1:=Zelle2. _
Value
Worksheets("Wartungskarte").Copy
Nummernkreis = InputBox("Bitte Nummernkreis eingeben:")
Range("B7").Value = Nummernkreis
Else: MsgBox "Kein Intevall vorhanden"
End If
Next 'fehlt !!!!!!
'Else: MsgBox "Kein Verantwortung vorhanden"
End If
'Durch den Filter ausgeblendete Zeilen löschen
Dim rng As Range
Dim lastrow As Long
Dim l As Long
Application.ScreenUpdating = False
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If lastrow > 1 Then
For l = lastrow To 1 Step -1
If Range("A" & l).EntireRow.Hidden Then
Range("A" & l).EntireRow.Delete
End If
Next l
End If
Application.ScreenUpdating = True
Dim x As Long, n As Long
n = 10
With Sheets("Wartungskarte")
For x = 30 To .Cells(Rows.Count, "G").End(xlUp).Row
If .Cells(x, "G")  "" Then
.Cells(x, "A") = n
n = n + 10
End If
Next
End With
' gefilterte Tabelle öffnen, umbennen, speichern und schließen
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\F5GDI4W\Documents\Wartungskarten\Vorlage" & "\" & Nummernkreis, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
Next
' Next zuviel !!!!!!!!
Unload Me
End Sub

Anzeige
AW: Verzweifelte Fehlersuche
11.11.2020 17:12:43
Luschi
Hallo Lars,
es gib zwar 3 x For und 3 x Next aber nicht korrekt gesetzt; in diesem Block fehlt das Next; 

If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(2), Zelle1.Value) > 0 Then
For Each Zelle2 In Range("Intervall")
If WorksheetFunction.CountIf(Sheets("Wartungsaufgaben").Columns(5), Zelle2.Value) > 0  _
Then
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=4, Criteria1:=Zelle2.Value
Worksheets("Wartungskarte").Copy
Nummernkreis = InputBox("Bitte Nummernkreis eingeben:")
Range("B7").Value = Nummernkreis
Else: MsgBox "Kein Intevall vorhanden"
End If
'Else: MsgBox "Kein Verantwortung vorhanden"
End If
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Verzweifelte Fehlersuche
12.11.2020 08:19:34
Lizzel
Moin Luschi,
das mit dem korrekt setzen der For ... Next... - Elemente war der entscheidende Hinweis.
Das verschieben des Else und des End If vor das passende Next, hat den Fehler behoben. Danke dafür!
Jetzt bleibt nur noch das Problem beim CountIf. Warum durchläuft er die Schleife, obwohl keine er nichts finden dürfte? Hab ich da was falsch geschrieben?
Gruß lars
https://www.herber.de/bbs/user/141492.xlsm
AW: Verzweifelte Fehlersuche
12.11.2020 11:03:40
Lizzel
Habe jetzt bemerkt das ich die falsche Sheet drinnen hatte, leider funktioniert es trotzdem nicht :(
AW: Verzweifelte Fehlersuche
12.11.2020 12:56:13
Lizzel
Mahlzeit,
ich hab meinen Code jetzt weiter angepasst/verfeinert.
Die Verantwortung klappt mittlerweile, aber beim Intervall macht er trotzdem leere Tabellen auf.
Ich verstehe nicht warum das eine klappt und das andere nicht. Aufgebaut sich sie identisch.
'Wartungskarten für E, M und M/E erstellen
'* Wartungsaufgaben in M, E und E/M sortieren, Karte kopieren und Umbennen
Dim Zelle1 As Range              'Für die Filterung
Dim Zelle2 As Range
Dim Nummernkreis As String
'** Nach Verantwortung filtern (E, M und E/M)
For Each Zelle1 In Range("Kriterien")
Sheets("Wartungskarte").Range("B30").AutoFilter Field:=1, Criteria1:=Zelle1.Value
If WorksheetFunction.CountIf(Sheets("Wartungskarte").Columns(2), Zelle1.Value) > 0 Then
'*** Nach Intervall filtern
For Each Zelle2 In Range("Intervall")
Sheets("Wartungskarte").Range("E30").AutoFilter Field:=4, Criteria1:=Zelle2.Value
If WorksheetFunction.CountIf(Sheets("Wartungskarte").Columns(5), Zelle2.Value) > 0 Then
Worksheets("Wartungskarte").Copy
Nummernkreis = InputBox("Bitte Nummernkreis eingeben für:" & Chr(13) & " _
Verantwortlich: " & Zelle1.Value & " (M: Mechaniker; E: Elektriker)" & Chr(13) & "Intervall: " & Zelle2.Value & " Wochen")
Range("B7").Value = Nummernkreis
'****Durch den Filter ausgeblendete Zeilen löschen
Dim rng As Range
Dim lastrow As Long
Dim l As Long
Application.ScreenUpdating = False
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If lastrow > 1 Then
For l = lastrow To 1 Step -1
If Range("A" & l).EntireRow.Hidden Then
Range("A" & l).EntireRow.Delete
End If
Next l
End If
Application.ScreenUpdating = True
'***** Nummeriert die Aufgaben durch
Dim x As Long, n As Long
n = 10
With ActiveSheet
For x = 30 To .Cells(Rows.Count, "G").End(xlUp).Row
If .Cells(x, "G")  "" Then
.Cells(x, "A") = n
n = n + 10
End If
Next
End With
'****** gefilterte Tabelle öffnen, umbennen, speichern und schließen
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\F5GDI4W\Documents\Wartungskarten\Vorlage" & "\" & Nummernkreis, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
Else: MsgBox "Kein Aufgaben für " & Zelle1.Value & " und " & Zelle2.Value & " vorhanden"
End If
Next
Else: MsgBox "Kein Verantwortung für " & Zelle1.Value & " vorhanden"
End If
Next

Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige