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

kleiner als

kleiner als
16.03.2006 12:13:44
WilhelmR.
Hallo,
ich drehe gleich durch, ich versuche mit den folgenden Makros die Eingabe in 2 Spalten zu überwachen:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D27")) Is Nothing Then
Call ErsteRoutine
ElseIf Not Intersect(Target, Range("B14:B27")) Is Nothing Then
Call ZweiteRoutine
End If
End Sub

Sub ErsteRoutine()
On Error Resume Next
Dim BBBereich As Range, BBZelle As Range
Set BBBereich = Range("D14:D27")
For Each BBZelle In Range("D14:D27")
If Intersect(BBZelle, BBBereich) Is Nothing Then Exit Sub
Dim intZahl As Double
intZahl = Sheets("SEGMENTE").Range("T4").Value
Application.EnableEvents = False
If BBZelle.Value > intZahl Then
MsgBox ("Wert zu hoch, bitte Blockmaß max. " & intZahl & " mm beachten"....")
BBZelle.ClearContents
BBZelle.Value = "" 'intZahl
End If
Application.EnableEvents = True
Next BBZelle
End Sub
Sub ZweiteRoutine()
On Error Resume Next
Dim AABereich As Range, AAZelle As Range
Set AABereich = Range("B14:B27")
For Each AAZelle In Range("B14:B27")
If Intersect(AAZelle, AABereich) Is Nothing Then Exit Sub
Dim antZahl As Double
antZahl = Sheets("SEGMENTE").Range("Z1").Value
Application.EnableEvents = False
If AAZelle.Value MsgBox ("Durchmesser zu klein, Berechnung erfolgt erst ab Ø " & antZahl & " mm " & vbCr & "bitte.......")
AAZelle.ClearContents
AAZelle.Value = ""
End If
Application.EnableEvents = True
Next AAZelle
End Sub
Problem: 1. Routine läuft einwandfrei.
2. Routine läuft nur wenn ich das oder = verändere.
(Zeile: If AAZelle.Value Ansonsten bläkt die MsgBox bei jeder beliebigen Eingabe los und will auch noch jede einzelne Zelle abfrühstücken und per ok bestätigt haben.
Mag VBA kein "kleiner als" Zeichen, oder wer weiss hier Rat.
mfg
Wilhelm

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: kleiner als
16.03.2006 13:06:01
Franz
Hallo Wilhelm,
Du muss die If-Bedingung in der 2. Routine anpassen. Durch die kleiner Bedingung wird die MsgBox auch bei allen Zellen angezeigt, die leer sind also den Wert 0 haben.

Sub ZweiteRoutine()
On Error Resume Next
Dim AABereich As Range, AAZelle As Range
Set AABereich = Range("B14:B27")
For Each AAZelle In Range("B14:B27")
If Intersect(AAZelle, AABereich) Is Nothing Then Exit Sub
Dim antZahl As Double
antZahl = Sheets("SEGMENTE").Range("Z1").Value
Application.EnableEvents = False
If AAZelle.Value < antZahl And AAZelle.Value > 0 Then
MsgBox ("Durchmesser zu klein, Berechnung erfolgt erst ab Ø " & antZahl & " mm " & vbCr & "bitte.......")
AAZelle.ClearContents
AAZelle.Value = ""
End If
Application.EnableEvents = True
Next AAZelle
End Sub
Alternativen:
If AAZelle.Value < antZahl And AAZelle.Value <> "" Then
If AAZelle.Value < antZahl And IsEmpty(AAZelle.Value) = False Then

Gruß
Franz
Anzeige
AW: kleiner als
16.03.2006 13:14:06
WilhelmR.
Hallo Franz,
wie Schuppen fiel es ihm von den Augen, klar.
Vielen Dank für deine Mühe.
Wilhelm

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige