Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
408to412
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
408to412
408to412
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Prüfen ob Aktuelle Tabelle..dann

Prüfen ob Aktuelle Tabelle..dann
Ralle74
Hallo zusammen,
ich habe dank der Hilfe von Ramses ein

Private Sub gebastelt.
Meine Datei umfasst ca. 34 Tabellen.
Das untenstehende 

Private Sub soll allerdings nur aktiv sein, wenn ich mich in den Tabellen g1-g16 befinde.
Momentan habe ich dieses Sub in jede der 16 Tabellen eingefügt, allerdings mit dem Problem dass es eben 16x vertreten ist und ich bei einer Änderung alle ändern müsste.
Wäre nett wenn mir jemand helfen könnte wie man diese Prüfung schreibt.
Viele Grüsse
Ralle

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Qe As Integer
If Target.Row = 11 And Target.Column = 3 And (Cells(5, 6) = "2" Or Cells(5, 6) = "4") Then
If Target.Value > 1000 And Target.Value <= 1450 Then
Qe = MsgBox("Über einer Breite von 1000mm ist schleifen nur mit Mehraufwand möglich!!", vbInformation + vbOKCancel, "Hinweis")
ElseIf Target.Value > 1450 Then
Qe = MsgBox("Über einer Breite von 1450 ist Schleifen nicht möglich!!", vbInformation + vbOKOnly, "Hinweis")
End If
End If
If Target.Row = 11 And Target.Column = 5 And (Cells(5, 6) = "2" Or Cells(5, 6) = "4") Then
If Target.Value > 2000 Then
Qe = MsgBox("Über einer Länge von 2000 ist Schleifen nicht möglich!!", vbInformation + vbOKOnly, "Hinweis")
End If
End If
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Prüfen ob Aktuelle Tabelle..dann
Bert
Verleg den Code in:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dann schreibst du die Blattnamen, in denen das wirken soll in ein Array
und prüfst damit ab, welches Blatt es ist.
Ggf. poste mal die Blattnamen der relevanten Blätter.
Bert
AW: Prüfen ob Aktuelle Tabelle..dann
Ralle74
Hi Bert,
erstmal danke für den Versuch aber leider verstehe ich nicht wie es gehen sollte.
Die relevanten Blätter in denen das Sub funtionieren muss heissen g1 g2 g3....bis g16.
Danke im Voraus
Ralle
AW: Prüfen ob Aktuelle Tabelle..dann
Bert
''Der Code m u s s in das Modul von "DieseArbeitsmappe"!!!!!!!!!!
Option Explicit
Option Base 1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Qe As Integer, arr, s As Byte, bolFound As Boolean
arr = Array("g1", "g2", "g3", "g4", "g5", "g6", "g7", "g8", "g9", "g10", "g11", "g12", "g13", "g14", "g15", "g16")
bolFound = False
For s = 1 To 16
If Sh.Name = arr(s) Then
bolFound = True
Exit For
End If
Next
If Not bolFound Then Exit Sub
If Target.Row = 11 And Target.Column = 3 And (Cells(5, 6) = "2" Or Cells(5, 6) = "4") Then
If Target.Value > 1000 And Target.Value <= 1450 Then
Qe = MsgBox("Über einer Breite von 1000mm ist schleifen nur mit Mehraufwand möglich!!", vbInformation + vbOKCancel, "Hinweis")
ElseIf Target.Value > 1450 Then
Qe = MsgBox("Über einer Breite von 1450 ist Schleifen nicht möglich!!", vbInformation + vbOKOnly, "Hinweis")
End If
End If
If Target.Row = 11 And Target.Column = 5 And (Cells(5, 6) = "2" Or Cells(5, 6) = "4") Then
If Target.Value > 2000 Then
Qe = MsgBox("Über einer Länge von 2000 ist Schleifen nicht möglich!!", vbInformation + vbOKOnly, "Hinweis")
End If
End If
End Sub

Bert
Anzeige
Danke Bert - genau das was ich gebraucht habe o.T.
Ralle74

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige