Makro mehre PRÜFUNGEN vor AUSFÜHRUNG

Hallo Gemeinde
Folgendes Problem
Ich möchte vor der Ausführung verschiedener Makros z.B. " Lagerzugang..... Andreas..."
einige Prüfungen laufen lassen ob es Ausgeführt werden darf.


Sub Lagerabgang_Andreas()
'Abfrage zum Ausführen
If MsgBox("Lagerabgang ANDREAS?, Ausführen JA NEIN? nur einmal pro Eingabe", vbYesNo) = vbNo Then Exit 

Sub  'DER TEIL Funktioniert
'Prüfung ob Artikel vorhanden
If Sheets("Materialschein").Cells(14, 3).Value > 0 Then
Else
MsgBox "Materialschein ist LEER"
Exit Sub
End If    'DER TEIL Funktioniert auch
'Prüfung ob NEUER Artikel POS 1- 22 vorhanden
If Sheets("Materialschein").Cells(14, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 1"
Exit Sub
End If
If Sheets("Materialschein").Cells(15, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 2"
Exit Sub
End If
If Sheets("Materialschein").Cells(16, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 3"
Exit Sub
End If
If Sheets("Materialschein").Cells(17, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 4"
Exit Sub
End If
If Sheets("Materialschein").Cells(18, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 5"
Exit Sub
End If
If Sheets("Materialschein").Cells(19, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 6"
Exit Sub
End If
If Sheets("Materialschein").Cells(20, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 7"
Exit Sub
End If
If Sheets("Materialschein").Cells(21, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 8"
Exit Sub
End If
If Sheets("Materialschein").Cells(22, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 9"
Exit Sub
End If
If Sheets("Materialschein").Cells(23, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 10"
Exit Sub
End If
If Sheets("Materialschein").Cells(24, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 11"
Exit Sub
End If
If Sheets("Materialschein").Cells(25, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 12"
Exit Sub
End If
If Sheets("Materialschein").Cells(26, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 13"
Exit Sub
End If
If Sheets("Materialschein").Cells(27, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 14"
Exit Sub
End If
If Sheets("Materialschein").Cells(28, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 15"
Exit Sub
End If
If Sheets("Materialschein").Cells(29, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 16"
Exit Sub
End If
If Sheets("Materialschein").Cells(30, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 17"
Exit Sub
End If
If Sheets("Materialschein").Cells(31, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 18"
Exit Sub
End If
If Sheets("Materialschein").Cells(32, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 19"
Exit Sub
End If
If Sheets("Materialschein").Cells(33, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 20"
Exit Sub
End If
If Sheets("Materialschein").Cells(34, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 21"
Exit Sub
End If
If Sheets("Materialschein").Cells(35, 14).Value = "" Then
Else
MsgBox "Neuer Artikel VORHANDEN Pos 22"
Exit Sub
End If  'DER TEIL Funktioniert auch
'Prüfung ob Stückzahl POS 1- 22 vorhanden
If Sheets("Materialschein").Cells(14, 2).Value > 0 And Cells(14, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 1 FEHLT"  'POS 1 Funktioniert
Exit Sub
End If
If Sheets("Materialschein").Cells(15, 3).Value > 0 And Cells(15, 2).Value > 0 Then
Else
MsgBox "Stückzahl Pos 2 FEHLT"  'Ab hier kommt mein PROBLEM , ist Cells(15, 3) Leer, Bekomme ich die MsgBox "Stückzahl Pos 2 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(16, 2).Value >= 0 And Cells(16, 3).Value >= 0 Then
Else
MsgBox "Stückzahl Pos 3 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(17, 2).Value >= "0" And Cells(17, 3).Value >= "0" Then
Else
MsgBox "Stückzahl Pos 4 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(18, 2).Value >= "0" And Cells(18, 3).Value >= "0" Then
Else
MsgBox "Stückzahl Pos 5 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(19, 2).Value >= 0 And Cells(19, 3).Value >= 0 Then
Else
MsgBox "Stückzahl Pos 6 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(20, 2).Value >= 0 And Cells(20, 3).Value >= 0 Then
Else
MsgBox "Stückzahl Pos 7 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(21, 2).Value > 0 And Cells(21, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 8 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(22, 2).Value > 0 And Cells(22, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 9 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(23, 2).Value > 0 And Cells(23, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 10 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(24, 2).Value > 0 And Cells(24, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 11 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(25, 2).Value > 0 And Cells(25, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 12 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(26, 2).Value > 0 And Cells(26, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 13 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(27, 2).Value > 0 And Cells(27, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 14 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(28, 2).Value > 0 And Cells(28, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 15 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(29, 2).Value > 0 And Cells(29, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 16 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(30, 2).Value > 0 And Cells(30, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 17 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(31, 2).Value > 0 And Cells(31, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 18 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(32, 2).Value > 0 And Cells(32, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 19 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(33, 2).Value > 0 And Cells(33, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 20 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(34, 2).Value > 0 And Cells(34, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 21 FEHLT"
Exit Sub
End If
If Sheets("Materialschein").Cells(35, 2).Value > 0 And Cells(35, 3).Value > 0 Then
Else
MsgBox "Stückzahl Pos 22 FEHLT"
Exit Sub
End If
'Prüfung Lagerbewertung / OHNE Stückzahl PRÜFUNG geht das auch
If Sheets("Materialschein").Cells(1, 16).Value = "Lagerabgang" Then
Range("B14:P35").Select
Selection.Copy
Sheets("temp").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B4:B25").Select
Application.CutCopyMode = False
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C4:C25").Select
Application.CutCopyMode = False
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G4:G25").Select
Application.CutCopyMode = False
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M4:M25").Select
Application.CutCopyMode = False
Selection.Copy
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$B$1:$P$25").AutoFilter Field:=15, Criteria1:= _
"Lagerabgang"
Range("A4:E25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("LA Andreas").Select
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
Selection.End(xlDown).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Range("A1").Select
Selection.End(xlDown).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Sheets("Materialschein").Select
Range("C14:F14").Select
Sheets("temp").Select
ActiveWindow.SmallScroll ToRight:=4
ActiveSheet.Range("$B$1:$P$25").AutoFilter Field:=15
Range("B4:P25").Select
Selection.ClearContents
Sheets("LA Andreas").Select
Range("A2").Select
Selection.End(xlDown).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Else
MsgBox "FALSCHE Lagerbewertung"
End If
End Sub

Es geht um Diesen Teil des Codes

'Prüfung ob Stückzahl POS 1- 22 vorhanden

If Sheets("Materialschein").Cells(14, 2).Value > 0 And Cells(14, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 1 FEHLT"  'POS 1 Funktioniert  

Exit Sub

End If

If Sheets("Materialschein").Cells(15, 3).Value > 0 And Cells(15, 2).Value > 0 Then

Else

MsgBox "Stückzahl Pos 2 FEHLT" 'Ab hier kommt mein PRBLEM , ist Cells(15, 3) Leer, Bekomme ich die MsgBox "Stückzahl Pos 2 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(16, 2).Value >= 0 And Cells(16, 3).Value >= 0 Then

Else

MsgBox "Stückzahl Pos 3 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(17, 2).Value >= "0" And Cells(17, 3).Value >= "0" Then

Else

MsgBox "Stückzahl Pos 4 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(18, 2).Value >= "0" And Cells(18, 3).Value >= "0" Then

Else

MsgBox "Stückzahl Pos 5 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(19, 2).Value >= 0 And Cells(19, 3).Value >= 0 Then

Else

MsgBox "Stückzahl Pos 6 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(20, 2).Value >= 0 And Cells(20, 3).Value >= 0 Then

Else

MsgBox "Stückzahl Pos 7 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(21, 2).Value > 0 And Cells(21, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 8 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(22, 2).Value > 0 And Cells(22, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 9 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(23, 2).Value > 0 And Cells(23, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 10 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(24, 2).Value > 0 And Cells(24, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 11 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(25, 2).Value > 0 And Cells(25, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 12 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(26, 2).Value > 0 And Cells(26, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 13 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(27, 2).Value > 0 And Cells(27, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 14 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(28, 2).Value > 0 And Cells(28, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 15 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(29, 2).Value > 0 And Cells(29, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 16 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(30, 2).Value > 0 And Cells(30, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 17 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(31, 2).Value > 0 And Cells(31, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 18 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(32, 2).Value > 0 And Cells(32, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 19 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(33, 2).Value > 0 And Cells(33, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 20 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(34, 2).Value > 0 And Cells(34, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 21 FEHLT"

Exit Sub

End If

If Sheets("Materialschein").Cells(35, 2).Value > 0 And Cells(35, 3).Value > 0 Then

Else

MsgBox "Stückzahl Pos 22 FEHLT"

Exit Sub

End If

Das Makro soll vor Ausführung Prüfen wenn eine Artikelnummer  eingetragen ist muss auch eine Stückzahl vorhanden sein  

Cells 14,3 - 35, 3 ist die Artikelnummer und 14,2 - 35,2 Angabe der Stückzahl 

ist keine Artikelnummer Eingetragen prüfe das nächste .... oder mach weiter / alles OK...

hab mit =...  0 "" ... für die einzelnen Cellen gespielt bekomme aber immer, wenn Artikel Nummer leer ist  an Fehler "Stückzahl Pos X Fehlt"

Bin kein VBA Profi hab mir alles zusammen Gegoogelt 

Wenn benötig lade ich die Datei mit hoch

Vielen Dank schon mal  

Gruß

Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim i As Integer, ok As Boolean ok = True With Sheets("Materialschein") For i = 14 To 35 ''durch Not (also Verneinung der Prüfung) entspricht das dem Else-Zweig If Not (.Cells(i, 2).Value > 0 And Cells(i, 3).Value > 0) Then 'Meldung MsgBox "Stückzahl Pos " & (i - 13) & " FEHLT" 'POS i funktioniert ''Abbruchbedingung ok = False ''For-Schleife sofort verlassen Exit For End If Next i End With ''Abbruchbedingung prüfen If Not ok Then Exit Sub '' und raus, wenn ok auf 'False steht ''hier gehts weiter, wenn die Variable 'ok' den Wert 'True' hat

Sub Unit() Dim A As Range, C As Range, Pos As String 'Bereich mit Artikeln Set A = Sheets("Materialschein").Range(Sheets("Materialschein").Cells(14, 3), Sheets("Materialschein").Cells(35, 3)) If WorksheetFunction.CountA(A) = 0 Then MsgBox "Keine Artikel!" Else For Each C In A.SpecialCells(xlCellTypeConstants).Offset(0, -1) 'Vorspalte zu Artikeln If Not IsNumeric(C.Text) Then Pos = Pos & ", " & C.Row - 13 Next If Len(Pos) > 0 Then MsgBox "Stückzahl fehlt bei Position(en): " & Mid(Pos, 3) Else MsgBox "Die Stückzahlen sind vollständig!" End If End If Set A = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Makro mehre PRÜFUNGEN vor AUSFÜHRUNG

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread