Microsoft Excel

Herbers Excel/VBA-Archiv

Schleife für Zelleninhalt-Prüfung | Herbers Excel-Forum


Betrifft: Schleife für Zelleninhalt-Prüfung von: Lenni
Geschrieben am: 15.11.2009 12:13:45

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

  

Betrifft: AW: Schleife für Zelleninhalt-Prüfung von: Tino
Geschrieben am: 15.11.2009 12:48:43

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


  

Betrifft: AW: Schleife für Zelleninhalt-Prüfung von: Lenni
Geschrieben am: 15.11.2009 13:25:51

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



  

Betrifft: ok. machen wir es so... von: Tino
Geschrieben am: 15.11.2009 14:22:24

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


  

Betrifft: Korrektur von: Tino
Geschrieben am: 15.11.2009 14:26:05

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


  

Betrifft: AW: Danke Tino!! von: Lenni
Geschrieben am: 15.11.2009 14:48:55

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...


  

Betrifft: AW: Danke Tino!! von: Tino
Geschrieben am: 15.11.2009 15:03:07

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


  

Betrifft: AW: Das klappt!! von: Lenni
Geschrieben am: 15.11.2009 15:29:58

Nochmals herzlichen Dank Tino!! Das "läuft rund"!!

Gruß
Lenni


Beiträge aus den Excel-Beispielen zum Thema "Schleife für Zelleninhalt-Prüfung"