Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1116to1120
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
Inhaltsverzeichnis

Schleife für Zelleninhalt-Prüfung

Schleife für Zelleninhalt-Prüfung
Lenni
Moin Excellianer!
Nach langer Zeit benötige ich wieder mal Eure Hilfe. Auch finde ich nix entsprechendes im Archiv (...aber vielleicht stelle ich ja die Fragen falsch...).
Ich habe zu diesem Zweck eine Beispielmappe hochgeladen. In dieser steht auch meine Fragestellung:
https://www.herber.de/bbs/user/65918.xls
In den roten Zellen darf erst ein Eintrag erfolgen, wenn in den jeweils darüber liegenden gelben Zellen ein Eintrag vorhanden ist. Allen farbig markierten Zellen sind per "Daten" > "Gültigkeit" eine Namensliste zugeordnet. Diese befindet sich in der Tabelle2. Mit einem kleinen VBA-Skribt ist mir das für die Zelle B12 gelungen... ....wenns auch nur zur Zelle B10 zurück geht... ...und leider auch keine wiederholte Prüfung stattfindet, wenn nachträglich der Name aus B10 gelöscht wird...
Mein Schmalspur-VBA setzt mir wieder mal Grenzen! Vielen Dank für Eure Hilfe!!
Viele Grüße aus dem hohen Norden!
Lenni

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

Betreff
Benutzer
Anzeige
AW: Schleife für Zelleninhalt-Prüfung
15.11.2009 12:48:43
Tino
Hallo,
versuche es mal so.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Intersect(Range("B12,E12,H12,B15,E15,H15,B18,E18,H18,B21,E21,H21"), Target)
If Not Bereich Is Nothing Then
Application.EnableEvents = False
For Each Bereich In Bereich.Areas
If Bereich.Offset(-2, 0) = "" Or Bereich.Offset(-1, 0) = "" Then
Bereich.Value = ""
End If
Next Bereich
Application.EnableEvents = True
End If
End Sub
Gruß Tino
AW: Schleife für Zelleninhalt-Prüfung
15.11.2009 13:25:51
Lenni
Hallo Tino!!!
Danke für Deine Antwort!! ...ich verstehe den Grundansatz!! Leider ist es nicht ganz so, wie ich es mir vorstelle und ich versuche nun Deinen Vorschlag mit meinem VBA "abzugleichen"... ...was soll ich sagen: Ich gehe lieber wieder ins Forum.
Wo habe ich noch Schwierigkeiten?: Ich bleibe mal bei Zelle B12. Steht in den Zellen B10:B11 nix drinne, dann darf auch kein Eintrag in B12 erfolgen und B12 wird gelöscht. ABER DANN soll es ja zur jeweils leeren Zelle B10 und/oder B11 zurück gehen, damit hier zunächst ein Eintrag per Dropdown erfolgt.
Weiter findet leider auch keine Prüfung in B12 statt, wenn nachträglich aus B10 oder B11 gelöscht wird.
UND natürlich soll dass denn bei allen anderen farbigen Bereichen dementsprechend funktionieren.
Hast Du noch Ideen?! Vielen Dank!!
Gruß
Lenni

Anzeige
ok. machen wir es so...
15.11.2009 14:22:24
Tino
Hallo,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BereichRot As Range, BereichGelb As Range

 Set BereichRot = Intersect(Range("B12,E12,H12,B15,E15,H15,B18,E18,H18,B21,E21,H21"), Target)
 Set BereichGelb = Intersect(Range("B10:B11,E10:E11,H10:H11,H13:H14,E13:E14,B13:B14,B16:B17,E16:E17,H16:H17,H19:H20,E19:E20,B19:B20"), Target)
 
 If Not BereichGelb Is Nothing Or Not BereichRot Is Nothing Then
  Application.EnableEvents = False
 
 
 If Not BereichGelb Is Nothing Then
  
    For Each BereichGelb In BereichGelb.Areas
     If BereichGelb(1, 1).Offset(2, 1).Value <> "" Then
        If BereichGelb(1, 1) = "" Or BereichGelb(2, 1) = "" Then
            BereichGelb(1, 1).Offset(2, 1).Value = ""
        End If
     End If
    Next BereichGelb

 End If
 
 If Not BereichRot Is Nothing Then
     For Each BereichRot In BereichRot.Areas
       If BereichRot <> "" Then
            If BereichRot.Offset(-2, 0) = "" Or BereichRot.Offset(-1, 0) = "" Then
                BereichRot.Value = ""
                If BereichRot.Offset(-1, 0) = "" Then
                  BereichRot.Offset(-1, 0).Select
                ElseIf BereichRot.Offset(-2, 0) = "" Then
                  BereichRot.Offset(-2, 0).Select
                End If
            End If
       End If
     Next BereichRot
 End If

 
 Application.EnableEvents = True
End If
End Sub
Gruß Tino
Anzeige
Korrektur
15.11.2009 14:26:05
Tino
Hallo,
falscher Offset.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BereichRot As Range, BereichGelb As Range

 Set BereichRot = Intersect(Range("B12,E12,H12,B15,E15,H15,B18,E18,H18,B21,E21,H21"), Target)
 Set BereichGelb = Intersect(Range("B10:B11,E10:E11,H10:H11,H13:H14,E13:E14,B13:B14,B16:B17,E16:E17,H16:H17,H19:H20,E19:E20,B19:B20"), Target)
 
 If Not BereichGelb Is Nothing Or Not BereichRot Is Nothing Then
  Application.EnableEvents = False
 
 
 If Not BereichGelb Is Nothing Then
  
    For Each BereichGelb In BereichGelb.Areas
     If BereichGelb(1, 1).Offset(2, 0).Value <> "" Then
        If BereichGelb(1, 1) = "" Or BereichGelb(2, 1) = "" Then
            BereichGelb(1, 1).Offset(2, 0).Value = ""
        End If
     End If
    Next BereichGelb

 End If
 
 If Not BereichRot Is Nothing Then
     For Each BereichRot In BereichRot.Areas
       If BereichRot <> "" Then
            If BereichRot.Offset(-2, 0) = "" Or BereichRot.Offset(-1, 0) = "" Then
                BereichRot.Value = ""
                If BereichRot.Offset(-1, 0) = "" Then
                  BereichRot.Offset(-1, 0).Select
                ElseIf BereichRot.Offset(-2, 0) = "" Then
                  BereichRot.Offset(-2, 0).Select
                End If
            End If
       End If
     Next BereichRot
 End If

 
 Application.EnableEvents = True
End If
End Sub
       
Gruß Tino
Anzeige
AW: Danke Tino!!
15.11.2009 14:48:55
Lenni
Danke Tino!! ...es funktioniert tadellos!! ...mit einer kleinen Einschränkung: Löscht man nachträglich aus den gleben Zellen, erfolgt keine erneute Prüfung und Rücksetzung in die soeben gelöschte Zelle. Ist aber das kleinste Übel und damit kann ich leben!!
Nochmals vielen Dank! ...ich habe wieder etwas zum nachdenken* und Da hast mir wiederholt sehr geholfen!!
Gruß
Lenni

*...vielleicht kriege das mit dem nachträglichen löschen noch selber hin...
AW: Danke Tino!!
15.11.2009 15:03:07
Tino
Hallo,
mach die Zeile
If BereichGelb(1, 1).Offset(2, 0).Value  "" Then
und die dazugehörige End IF.
raus
Also so
'...
If Not BereichGelb Is Nothing Then
For Each BereichGelb In BereichGelb.Areas
If BereichGelb(1, 1) = "" Or BereichGelb(2, 1) = "" Then
BereichGelb(1, 1).Offset(2, 0).Value = ""
End If
Next BereichGelb
End If
'...
Gruß Tino
Anzeige
AW: Das klappt!!
15.11.2009 15:29:58
Lenni
Nochmals herzlichen Dank Tino!! Das "läuft rund"!!
Gruß
Lenni

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige