MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 17.06.2015, 20:32   #1
Timo001
Neuer Benutzer
Neuer Benutzer
Standard VBA - Bestimmter Bereich nacheinander entsperren / Meldung

Hallo zusammen,

ich hoffe Ihr könnt mir bei folgendem helfen. Ich komm da nicht mehr weiter.
Ein Teil vom Code steht unten und die Excel Datei ist mit im Anhang.
Kurz um was es geht. Es geht um Zeiträume die man eingeben kann und die sich dann automatisch die in der Zeit befindlichen Daten
zusammen suchen.
Im Bereich B14:C18 kann man Zeiträume eingeben. In E14:E18 werden dann die Daten von der Tabelle "Daten" gesucht. Drückt man
auf berechnen, nimmt es den letzten Zeitraum von C14:C18 und setzt in B21 dieses Datum +1 Tag
Hoffe es ist verständlich, ansonsten grad probieren. Funktioniert eigtl. alles bis auf folgendes:

1.Ist es möglich das B15:B18 und C15:C18 nicht vom Nutzer anwählbar sind. Sodass er in B14 und C14 anfangen muss. Stehen diese zwei
Werte drin, wird B15 und C15 entsperrt. Sind diese beiden befüllt wird der nächste Bereich entsperrt usw.
Und das ganze auch farblich halten. Sodass B14 und C14 erstmal grau sind. Werte stehen drin und dann wird B15 und C15 grau usw.

2.Wenn C14 kleiner als B14 ist, sollte eine Meldung kommen (Datum falsch). Bei den anderen Zeiträumen genauso.

3. Wenn möglich noch eine Meldung das wenn man ein Zeitraum eingibt, und diesen Zeitraum gibt es in der Tabelle "Daten" nicht
(Zeitraum nicht vorhanden) Meldung

4. Steht kein Zeitraum in B14:B18 und C14:C18 und man auf berechnen klickt, setzt es immer in C21 den 01.01.1900 ?
Irgendwie klappt es nicht das es dann nichts anzeigen soll. Bzw hier evtl auch eine Meldung mit "Wert eingeben" wär nicht schlecht.



Bin dankbar für jede Hilfe
Gruß
Timo



'letzter Datumswert im Bereich C14:C18 wird ermittelt und in C21 eingetragen, +1 Tag
Private Sub CommandButton1_Click()

If Range("C15") = "" Then
Range("B21").Value = Range("C14") + 1
ElseIf Range("C16") = "" Then
Range("B21").Value = Range("C15") + 1
ElseIf Range("C17") = "" Then
Range("B21").Value = Range("C16") + 1
ElseIf Range("C18") = "" Then
Range("B21").Value = Range("C17") + 1
Else
Range("B21").Value = Range("C18") + 1
End If


'Datumsangaben Zeile 22 ermitteln
With Me.Range("B21")
Me.Range("B22").Value = .Value
End With


End Sub
Angehängte Dateien
Dateityp: xlsm Test.xlsm (47,9 KB, 6x aufgerufen)
Timo001 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.06.2015, 09:10   #2
aloys78
MOF Meister
MOF Meister
Standard

Hallo Timo,

Zitat:

3. Wenn möglich noch eine Meldung das wenn man ein Zeitraum eingibt, und diesen Zeitraum gibt es in der Tabelle "Daten" nicht
(Zeitraum nicht vorhanden) Meldung

Verständnisfrage dazu
Beispieleingabe: 1.2.12 bis 10.2.12
Klar ist der Fehler, wenn keiner dieser Tage in Daten vertreten ist.
Wie sieht es aus, wenn zB nur Daten vom 5.2.12 - 8.2.12 vorhanden sind?

Die Eingabezeilen sollen schrittweise entsperrt werden. Dazu muß der Blattschutz eingeschaltet sein. Gibt es weitere Eingabezellen/-bereiche in diesem Blatt ? Soll der Blattschutz mit Password erfolgen ?

Wegen der Farbe im Eingabeblock ist die Schrift schwer lesbar; soll das Blau dort so bleiben ?

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 19.06.2015, 16:57   #3
Timo001
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Aloys,

wenn der Nutzer z.B in "B14" 10.10.2011 und in "C14" 20.11.2011 eingibt, sollte eine Meldung kommen mit "Zeitraum nicht vorhanden, bitte neu eingeben" z.B
Erst wenn alles korrekt ist, sollte die nächste Zeile zur Eingabe entsperrt werden.

in der Arbeitsmappe ist alles gesperrt bis auf:
A7, B14, C14, E14:E18, C21:C22
ist nochmal im Anhang. PW: TEST!

mit der Farbe hast recht aber ein leichtes grau im Hintergrund oder weis langt schon. Schriftfarbe bleibt ja schwarz.

Danke schon mal und Gruß
Timo
Angehängte Dateien
Dateityp: xlsm Test.xlsm (49,2 KB, 6x aufgerufen)
Timo001 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.06.2015, 07:11   #4
aloys78
MOF Meister
MOF Meister
Standard

Hallo Timo,

nachstehend mein Code-Vorschlag für Blatt 'Start', der u.a. den bisherige Code für CommandButtons 1 und 2 ergänzt.
Unverändert bleibt der Code für die Checkboxen.
Der erforderliche Code für die Einrichtung des Blattschutzes ist von Dir schon eingefügt worden, deswegen kein Vorschlag dazu.
Unklar ist mir, warum C21:C22 nicht gesperrt sein sollen; das hat aber keinen Einfluß auf meinen Code.

Nach dem ersten Start bitte Button 'Leeren' drücken, damit wird der Eingabebereich formatiert.

Gruß
Aloys
Code:

Option Explicit

Const fLocked As Long = 11892015    'Farbe grau für entsperrten Eingabebereich
Const fUnLocked As Long = 14277081  'Farbe blau für noch gepsperrten Eingabebereich


Private Sub Worksheet_Change(ByVal Target As Range)
'========================================================================================
' Change-Ereignis  -  im Bereich B14:C18 wurde der Inhalt einer Zelle verändert
'========================================================================================
    Dim dVon As Date                'Von-Datum
    Dim dBis As Date                'Bis-Datum
    Dim wsD As Worksheet            'Sheet 'Daten'
    Dim erg                         'Ergebnis Match
    Dim rng_Datum As Range          'Datum-Spalte in 'Daten'
    Dim LoL As Long                 'letzte Zeilen#
    Dim r As Long                   'Zeilen#
    Dim msg_E As String
    
'check, ob Änderung im richtigen Bereich erfolgte
    If Target.Count > 1 Then Exit Sub           'mehr als eine Zelle betroffen
    If Intersect(Target, Range("B14:C18")) Is Nothing Then Exit Sub 'geänderte Zelle außerhalb Zielbereich
    
'prüfe, ob gültiges Datum eingegeben
    If Target = "" Or Not IsDate(Target) Then
        MsgBox "Kein gültiges Datum eingegeben !", vbExclamation
        Target.Select
        Exit Sub
    End If
                
'initialisierug
    Set wsD = Worksheets("Daten")
    LoL = wsD.Cells(Rows.Count, "D").End(xlUp).Row      'Zeilen# letzter Datumswert in 'Daten'
    msg_E = "Eingabe bitte korrigieren !"
    
'Verarbeiten Eingaben in den Spalten B und C
    Select Case Target.Column
        
        Case Is = 2                     'Spalte B
            dVon = Target                   'Von-Datum
            With wsD
                If dVon < .Range("D2") Then
                    MsgBox "Von-Datum liegt vor dem ersten Datum !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                ElseIf dVon > .Range("D" & LoL) Then
                    MsgBox "Von-Datum liegt jenseits des letzten Datums !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                End If
            End With
            Target.Offset(0, 1).Select      'Von-Datum ist gültig, Cursor auf Bis-Datum
    
        Case Is = 3                     'Spalte 3
            dVon = Target.Offset(0, -1)     'Von-Datum
            dBis = Target                   'Bis-Datum
            
         'Plausibilitätsprüfung
            With wsD
                If dVon > dBis Then                     'Von-Datum > Bis-Datum
                    MsgBox "Bis-Datum < Von-Datum !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                ElseIf dBis > .Range("D" & LoL) Then    'Bis-Datum > Maximal-Datum
                    MsgBox "Bis-Datum jenseits des letzten Datums !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                End If
            End With
            
         'Von- und Bis-Datum innerhalb der Datum-Skala
            r = Target.Row                      'Zeilen# der aktuellen Eingabezeile
            With Range("B" & r & ":C" & r)      'bisherige Eingabezeile sperren und entsprechend einfärben
                .Locked = True
                .Interior.Color = fLocked
            End With
            
         'neue Eingabezeile vorbereiten
            r = r + 1
            If r <= 18 Then                     'es gibt noch mindestens eine weitere Eingabezeile
                With Range("B" & r & ":C" & r)  'neue Eingabezeile entsperren und als Eingabezeile einfärben
                    .Locked = False
                    .Interior.Color = fUnLocked
                    Range("B" & r).Select
                End With
            End If
    End Select
End Sub

    
Private Sub CommandButton1_Click()
'========================================================================================
' CommandButton1 - Berechnen
'   letzter Datumswert im Bereich C14:C18 wird ermittelt, um 1 erhöht und
'   in C21 eingetragen.
'========================================================================================
        
'letztes Bis-Datum wird ermittel
    If Range("C14") <> "" Then          'mindestens die erste Einggabezeile enthält Daten
        If Range("C15") = "" Then
                Range("B21").Value = Range("C14") + 1
            ElseIf Range("C16") = "" Then
                Range("B21").Value = Range("C15") + 1
            ElseIf Range("C17") = "" Then
                Range("B21").Value = Range("C16") + 1
            ElseIf Range("C18") = "" Then
                Range("B21").Value = Range("C17") + 1
            Else
                Range("B21").Value = Range("C18") + 1
        
'       Datumsangaben Zeile 22 ermitteln
            With Me.Range("B21")
                Me.Range("B22").Value = .Value
            End With
        End If
    
    Else                                'es wurden keine Daten eingegeben
        MsgBox "Es liegen keine Eingabedaten vor !" & Chr(10) & Chr(10) _
            & "Bitte Werte eingeben !", vbExclamation
    End If
            
End Sub

    
Private Sub CommandButton2_Click()
'========================================================================================
' Button 'Daten leeren'
'========================================================================================
    
'Eingabe- und Anzeigeblock: Inhalte löschen
    Application.EnableEvents = False
    Range("B14:C18").ClearContents
    Range("E14:E18").ClearContents
    Range("B21:C22").ClearContents
    Application.EnableEvents = True
    
'Eingabe- und Anzeigeblock: Zellen sperren und einfärben
    With Range("B14:C14")               'die esrte Eingabezeile wird entsperrt
        .Locked = False
        .Interior.Color = fUnLocked
    End With
    With Range("B15:C18")               'die übrigen Eingabezeilen werden gesperrt
        .Locked = True
        .Interior.Color = fLocked
    End With
        
'Checkboxen in Grundstellung
    CheckBox1.Value = False
    CheckBox2.Value = False
    CheckBox3.Value = False
    CheckBox4.Value = False
    CheckBox5.Value = False
    CheckBox6.Value = False
    
End Sub

Geändert von aloys78 (20.06.2015 um 07:55 Uhr).
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.06.2015, 20:50   #5
Timo001
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Aloys,

einfach Weltklasse! Echt Spitze.
Ich dank Dir

Gruß
Timo
Timo001 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.06.2015, 22:12   #6
Timo001
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Aloys,
Du hast mir vor ein paar Tagen super geholfen mit deinem Code. Dafür nochmal eine großes Dankeschön.
Nach reichlich testen hätte ich noch folgendes. Habe es auch selber versucht, bekomme es aber nicht hin.
Falls man bei meinen drei Punkten alles mögliche im Code umstellen müsste, dann lassen wir´s. Ich will dich da nicht zu lang mit aufhalten.

1. Das der Nutzer noch einfacher Schrittweise durchgeführt wird. Beim Start sollte nur "B14" anwählbar und grau sein. Ist dieses Datum korrekt (ist in Tabelle "Daten" vorhanden), dann soll "C14" anwählbar und grau sein. Ist dieses Datum auch korrekt (nicht kleiner als "B14" und in der
Tabelle "Daten" vorhanden) soll "E14" anwählbar und grau sein. Steht in "E14" ein Wert (nur Zahlen erlaubt) soll "B15" anwählbar sein. Steht in"E14" kein Wert, soll eine Meldung kommen "Erst Wert eingeben, keiner vorhanden dann eine 0 eingeben". Erst dann soll "B15" anwählbar sein. So sollte es dann durch die ganzen Reihen gehen.

2. In "D14: D18" ; "D21: D22" ist meine Formel die sich die Werte von der Tabelle "Daten" sucht. Ist es möglich diese Formel in VBA beim Button "berechnen" zu hinterlegen?
Das erst beim Klick auf berechnen die Felder ausgefüllt werden. Weil, wenn das "bis" Datum nicht in der Tabelle "Daten" vorhanden ist, es mir dann trotzdem den letzten Wert errechnet der in der Tabelle "Daten" steht.
Bsp. 20.01.2013 - 20.04.2016
2016 gibt es ja nicht in der Tabelle "Daten". Es erscheint zwar die Meldung Zeitraum nicht vorhanden, es setzt mir aber dann trotzdem in "D" den Wert vom 20.01.2013 - 11.01.2014. Er rechnet also bis zum letzten Wert der in Tabelle "Daten" steht. Ist logisch, soll es aber nicht gleich einfügen.
Somit erst mit dem klick auf berechnen die Werte einfügen. Formeln sind:
in D14 =SUMMENPRODUKT((Daten!D2:E9999>=B14)*(Daten!D29999<=C14)*(Daten!E2:E9999))
in D15 =SUMMENPRODUKT((Daten!D310000>=B15)*(Daten!D310000<=C15)*(Daten!E3:E10000))
in D16 =SUMMENPRODUKT((Daten!D410001>=B16)*(Daten!D410001<=C16)*(Daten!E4:E10001))
in D17 =SUMMENPRODUKT((Daten!D510002>=B17)*(Daten!D510002<=C17)*(Daten!E5:E10002))
in D18 =SUMMENPRODUKT((Daten!D610003>=B18)*(Daten!D610003<=C18)*(Daten!E6:E10003))
in D21 =SUMMENPRODUKT((Daten!D29999>=B21)*(Daten!D29999<=C21)*(Daten!E2:E9999))
in D22 =SUMMENPRODUKT((Daten!D310000>=B22)*(Daten!D310000<=C22)*(Daten!E3:E10000))

3. In "C21:C22" kann man erst was eingeben wenn "B21:B22" befüllt sind. Auch in "C21:C22" sollte dann eine Meldung kommen wenn das "bis" Datum kleiner als das "von" Datum ist, oder das "bis" Datum nicht in der Tabelle "Daten" ist.

in der Arbeitsmappe wäre dann alles gesperrt bis auf:
A7, B14
ist nochmal im Anhang. PW: TEST!

Also wenn das noch klappen würde, wär´s einfach Top!

Gruß
Timo
Angehängte Dateien
Dateityp: xlsm Test1.xlsm (53,8 KB, 3x aufgerufen)
Timo001 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.06.2015, 17:46   #7
aloys78
MOF Meister
MOF Meister
Standard

Hallo Timo,

anbei eine neue Version, die auch die neuen Anforderungen abdecken sollte.

Gruß
Aloys
Code:

Option Explicit

'Version V3 vom 24.06.2015

Const fLocked As Long = 11892015    'Farbe grau für entsperrten Eingabebereich
Const fUnLocked As Long = 14277081  'Farbe blau für noch gepsperrten Eingabebereich
Dim LoL As Long                     'letzte Zeilen#
Dim erg                             'Ergebnis Match
Dim wsD As Worksheet                'Sheet 'Daten'
Dim r As Long                       'Zeilen#
Dim c As Long                       'Spalten#


Private Sub Worksheet_Change(ByVal Target As Range)
'========================================================================================
' Change-Ereignis  -  im Bereich B14:C18 wurde der Inhalt einer Zelle verändert
'========================================================================================
    Dim dVon As Date                'Von-Datum
    Dim dBis As Date                'Bis-Datum
    Dim rng_Datum As Range          'Datum-Spalte in 'Daten'
    Dim msg_E As String
    
'check, ob Änderung im richtigen Bereich erfolgte
    If Target.Count > 1 Then Exit Sub           'mehr als eine Zelle betroffen
    If Intersect(Target, Range("B14:C18")) Is Nothing Then Exit Sub 'geänderte Zelle außerhalb Zielbereich
    
'prüfe, ob gültiges Datum eingegeben
    If Target = "" Or Not IsDate(Target) Then
        MsgBox "Kein gültiges Datum eingegeben !", vbExclamation
        Target.Select
        Exit Sub
    End If
                
'initialisierug
    Set wsD = Worksheets("Daten")
    LoL = wsD.Cells(Rows.Count, "D").End(xlUp).Row      'Zeilen# letzter Datumswert in 'Daten'
    msg_E = "Eingabe bitte korrigieren !"
    
'Verarbeiten Eingaben in den Spalten B und C
    Select Case Target.Column
        
        Case Is = 2                     'Spalte B
            dVon = Target                   'Von-Datum
            With wsD
                If dVon < .Range("D2") Then
                    MsgBox "Von-Datum liegt vor dem ersten Datum !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                ElseIf dVon > .Range("D" & LoL) Then
                    MsgBox "Von-Datum liegt jenseits des letzten Datums !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                End If
            End With
            With Target
                .Locked = True                  'Zelle Bx sperren
                .Interior.Color = fLocked
            End With
            With Target.Offset(0, 1)
                .Locked = False                 'Nachbarzelle Cx entsperren
                .Interior.Color = fUnLocked     'Nachbarzelle Cx als Eingabezelle einfärben
                .Select                         'Von-Datum ist gültig, Cursor auf Bis-Datum
            End With
    
        Case Is = 3                     'Spalte 3
            dVon = Target.Offset(0, -1)         'Von-Datum
            dBis = Target                       'Bis-Datum
            
         'Plausibilitätsprüfung
            With wsD
                If dVon > dBis Then                     'Von-Datum > Bis-Datum
                    MsgBox "Bis-Datum < Von-Datum !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                ElseIf dBis > .Range("D" & LoL) Then    'Bis-Datum > Maximal-Datum
                    MsgBox "Bis-Datum jenseits des letzten Datums !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                End If
            End With
            
         'Auch Bis-Datum innerhalb der Datum-Skala
            With Target      'bisherige Eingabezelle sperren und entsprechend einfärben
                .Locked = True
                .Interior.Color = fLocked
            End With
            
         'neue Eingabezelle vorbereiten
            r = Target.Row + 1
            If r <= 18 Then                     'es gibt noch mindestens eine weitere Eingabezeile
                With Range("B" & r)             'neue Eingabezeile entsperren und als Eingabezeile einfärben
                    .Locked = False
                    .Interior.Color = fUnLocked
                    .Select
                End With
            End If
    End Select
End Sub

    
Private Sub CommandButton1_Click()
'========================================================================================
' CommandButton1 - Berechnen
'   letzter Datumswert im Bereich C14:C18 wird ermittelt, um 1 erhöht und
'   in C21 eingetragen.
'========================================================================================
        
'letztes Bis-Datum wird ermittel
    If Range("C14") <> "" Then          'mindestens die erste Einggabezeile enthält Daten
        If Range("C15") = "" Then
                Range("B21").Value = Range("C14") + 1
            ElseIf Range("C16") = "" Then
                Range("B21").Value = Range("C15") + 1
            ElseIf Range("C17") = "" Then
                Range("B21").Value = Range("C16") + 1
            ElseIf Range("C18") = "" Then
                Range("B21").Value = Range("C17") + 1
            Else
                Range("B21").Value = Range("C18") + 1
        
'       Datumsangaben Zeile 22 ermitteln
            With Me.Range("B21")
                Me.Range("B22").Value = .Value
            End With
        End If
    
'   Vergleiche C21 mit C22
        If Range("C21") = "" Or Not IsDate(Range("C21")) Then
            MsgBox "Datum in C21 fehlt oder  ungültig !", vbExclamation
            Range("C21").Select
            Exit Sub
        ElseIf Range("C22") = "" Or Not IsDate(Range("C22")) Then
            MsgBox "Datum in C22 fehlt oder  ungültig !", vbExclamation
            Range("C22").Select
            Exit Sub
        End If
        
        LoL = Worksheets("Daten").Cells(Rows.Count, "D").End(xlUp).Row
        erg = Application.Match(Range("C22"), Worksheets("Daten").Range("D2:D" & LoL), 0)
        If Not IsNumeric(erg) Then
            MsgBox "Datum in C22 nicht im Blatt 'Daten' gefunden !", vbExclamation
            Range("C22").Select
            Exit Sub
        ElseIf Range("C21") > Range("C22") Then
            MsgBox "Datum in C22 < Datum in C21 !", vbExclamation
            Range("C22").Select
            Exit Sub
        End If
        
'Formeln einfügen
        c = 1
        For r = 14 To 18
        c = c + 1
            Range("D" & r).FormulaLocal = "=SUMMENPRODUKT((Daten!D" & c & ":E9999>=B" & r & ")*(Daten!D" & c & ":D9999<=C" & r & ")*(Daten!E" & c & ":E9999))"
        Next r
        
        c = 1
        For r = 21 To 22
        c = c + 1
            Range("D" & r).FormulaLocal = "=SUMMENPRODUKT((Daten!D" & c & ":E9999>=B" & r & ")*(Daten!D" & c & ":D9999<=C" & r & ")*(Daten!E" & c & ":E9999))"
        Next r
    
    Else                                'es wurden keine Daten eingegeben
        MsgBox "Es liegen keine Eingabedaten vor !" & Chr(10) & Chr(10) _
            & "Bitte Werte eingeben !", vbExclamation
    End If
            
End Sub

    
Private Sub CommandButton2_Click()
'========================================================================================
' Button 'Daten leeren'
'========================================================================================
    
'Eingabe- und Anzeigeblock: Inhalte löschen
    Application.EnableEvents = False
    Range("B14:C18").ClearContents
    Range("E14:E18").ClearContents
    Range("B21:C22").ClearContents
    Union(Range("D14:D18"), Range("D21:D22")).ClearContents
    Application.EnableEvents = True
    
'Eingabe- und Anzeigeblock: Zellen sperren und einfärben
    With Range("B14")                           'die erste Eingabezelle wird entsperrt
        .Locked = False
        .Interior.Color = fUnLocked
    End With
    With Union(Range("C14"), Range("B15:C18"))  'die übrigen Eingabezeilen werden gesperrt
        .Locked = True
        .Interior.Color = fLocked
    End With
        
'Checkboxen in Grundstellung
    CheckBox1.Value = False
    CheckBox2.Value = False
    CheckBox3.Value = False
    CheckBox4.Value = False
    CheckBox5.Value = False
    CheckBox6.Value = False
    
End Sub
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.06.2015, 20:11   #8
Timo001
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Aloys,

danke schon mal für Deine Hilfe. Funktioniert leider noch nicht richtig.

Wenn "B14" korrekt dann "C14" entsperren (das klappt). Dann sollte aber wenn "C14" korrekt, "E14" entsperrt werden. Ist in "E14" ein Wert (irgendeine Zahl), soll es in "B15" weitergehen.
"B15" korrekt dann "C15" entsperren, "C15" korrekt dann "E15" entsperren usw.

"C21" und "C22" sollte es entsperren, sobald in "B21, B22" ein Wert drin steht. (die Werte in "B21:B22" werden ja automatisch nach klick auf "berechnen" übernommen. Das klappt, nur dann sollte "C21:C22" entsperrt werden)

Das mit den Formeln klappt leider auch nicht. Es wird nach dem klick auf "berechnen" nichts im Bereich "D14: D18, D21: D22" eingetragen.

Auch wenn z.B alles ausgefüllt ist, kommt nach ausführen des "berechnen" Button die Meldung: Es liegen keine Eingabedaten vor, bitte Werte eingeben.


Gruß
Timo
Angehängte Dateien
Dateityp: xlsm Test1.xlsm (61,6 KB, 6x aufgerufen)
Timo001 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 25.06.2015, 11:01   #9
aloys78
MOF Meister
MOF Meister
Standard

Hallo Timo,

Zitat:

Das mit den Formeln klappt leider auch nicht.

Klar, wenn Du den Code veränderst.

Anbei eine neue Version.

Gruß
Aloys
Code:

Option Explicit

'Version V4 vom 25.06.2015

Const fLocked As Long = 11892015    'Farbe grau für entsperrten Eingabebereich
Const fUnLocked As Long = 14277081  'Farbe blau für noch gepsperrten Eingabebereich
Const fZeile2122 As Long = 1137094
Dim LoL As Long                     'letzte Zeilen#
Dim erg                             'Ergebnis Match
Dim wsD As Worksheet                'Sheet 'Daten'
Dim r As Long                       'Zeilen#
Dim c As Long                       'Spalten#


Private Sub Worksheet_Change(ByVal Target As Range)
'========================================================================================
' Change-Ereignis  -  im Bereich B14:C18 wurde der Inhalt einer Zelle verändert
'========================================================================================
    Dim dVon As Date                'Von-Datum
    Dim dBis As Date                'Bis-Datum
    Dim rng_Datum As Range          'Datum-Spalte in 'Daten'
    Dim msg_E As String
    
'-------------------------------------------------------------------------------------
'check, ob Änderung im richtigen Bereich erfolgte und Initialisieren
'-------------------------------------------------------------------------------------
    If Target.Count > 1 Then Exit Sub           'mehr als eine Zelle betroffen
    If Intersect(Target, Union(Range("B14:C18"), Range("E14:E18"), Range("C21:C22"))) Is Nothing Then Exit Sub 'geänderte Zelle außerhalb Zielbereich
                
'initialisierug
    Set wsD = Worksheets("Daten")
    LoL = wsD.Cells(Rows.Count, "D").End(xlUp).Row      'Zeilen# letzter Datumswert in 'Daten'
    msg_E = "Eingabe bitte korrigieren !"
    
'-------------------------------------------------------------------------------------
' Berarbeiten C21- bzw C22-Input
'-------------------------------------------------------------------------------------
    If Target.Address(0, 0) = "C21" Or Target.Address(0, 0) = "C22" Then
'     check, ob gültiges Datum vorliegt
        If Target = "" Or Not IsDate(Target) Then
            MsgBox "Datum ist ungültig !", vbExclamation
            Target.Select
            Exit Sub
        End If
        
        
        LoL = Worksheets("Daten").Cells(Rows.Count, "D").End(xlUp).Row
        erg = Application.Match(Target, Worksheets("Daten").Range("D2:D" & LoL), 0)
        If Not IsNumeric(erg) Then
            MsgBox "Datum im Blatt 'Daten' nicht gefunden !", vbExclamation
            Target.Select
            Exit Sub
        End If
        Range("C22").Select
            
'    Vergleiche C22 mit C21
        If Target.Address(0, 0) = "C22" And IsDate(Range("C21")) Then
            If Range("C21") > Range("C22") Then
                MsgBox "Bis-Datum in C22 < Datum in C21 !", vbExclamation
                Range("C22").Select
                Exit Sub
            End If
        End If
        Exit Sub
    End If

'-------------------------------------------------------------------------------------
' Berarbeiten Input im Bereicb B14:C18 und E14:E18
'-------------------------------------------------------------------------------------
' prüfe, ob in Sp A / B gültiges Datum eingegeben
    If Target.Column = 2 Or Target.Column = 3 Then
        If Target = "" Or Not IsDate(Target) Then
            MsgBox "Kein gültiges Datum eingegeben !", vbExclamation
            Target.Select
            Exit Sub
        End If
    End If

'Verarbeiten Eingaben in den Spalten B, C und E
    Select Case Target.Column
        
        Case Is = 2                     'Spalte B
            dVon = Target                   'Von-Datum
            With wsD
                If dVon < .Range("D2") Then
                    MsgBox "Von-Datum liegt vor dem ersten Datum !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                ElseIf dVon > .Range("D" & LoL) Then
                    MsgBox "Von-Datum liegt jenseits des letzten Datums !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                End If
            End With
            With Target
                .Locked = True                  'Zelle Bx sperren
                .Interior.Color = fLocked
            End With
            With Target.Offset(0, 1)
                .Locked = False                 'Nachbarzelle Cx entsperren
                .Interior.Color = fUnLocked     'Nachbarzelle Cx als Eingabezelle einfärben
                .Select                         'Von-Datum ist gültig, Cursor auf Bis-Datum
            End With
    
        Case Is = 3                     'Spalte C
            dVon = Target.Offset(0, -1)         'Von-Datum
            dBis = Target                       'Bis-Datum
            
         'Plausibilitätsprüfung
            With wsD
                If dVon > dBis Then                     'Von-Datum > Bis-Datum
                    MsgBox "Bis-Datum < Von-Datum !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                ElseIf dBis > .Range("D" & LoL) Then    'Bis-Datum > Maximal-Datum
                    MsgBox "Bis-Datum jenseits des letzten Datums !" & Chr(10) & Chr(10) _
                        & msg_E, vbExclamation
                    Target.Select
                    Exit Sub
                End If
            End With
            
         'Auch Bis-Datum innerhalb der Datum-Skala
            With Target      'bisherige Eingabezelle sperren und entsprechend einfärben
                .Locked = True
                .Interior.Color = fLocked
            End With
            
         'neue Eingabezelle vorbereiten
            With Target.Offset(0, 2)            'neue Eingabezelle entsperren und als Eingabezelle einfärben
                .Locked = False
                .Interior.Color = fUnLocked
                .Select
            End With
            
        Case Is = 5                     'Spalte E
            If Target = "" Or Not IsNumeric(Target) Then
                MsgBox "Keine Eingabe erfolgt oder Daten nicht numerisch !", vbExclamation
                Target.Select
                Exit Sub
            Else
                With Target
                    .Locked = True                  'Zelle Bx sperren
                    .Interior.Color = fLocked
                End With
            End If
            
            r = Target.Row + 1
            If r <= 18 Then                     'es gibt noch mindestens eine weitere Eingabezeile
                With Range("B" & r)             'neue Eingabezeile entsperren und als Eingabezeile einfärben
                    .Locked = False
                    .Interior.Color = fUnLocked
                    .Select
                End With
            End If
    End Select
End Sub


    
Private Sub CommandButton1_Click()
'========================================================================================
' CommandButton1 - Berechnen
'   letzter Datumswert im Bereich C14:C18 wird ermittelt, um 1 erhöht und
'   in B21 eingetragen.
'========================================================================================
        
'letztes Bis-Datum wird ermittelt
    
    If Range("C14") <> "" Then          'mindestens die erste Einggabezeile enthält Daten
        Application.EnableEvents = False
        If Range("C15") = "" Then
            Range("B21").Value = Range("C14") + 1
        ElseIf Range("C16") = "" Then
            Range("B21").Value = Range("C15") + 1
        ElseIf Range("C17") = "" Then
            Range("B21").Value = Range("C16") + 1
        ElseIf Range("C18") = "" Then
            Range("B21").Value = Range("C17") + 1
        Else
            Range("B21").Value = Range("C18") + 1
        End If

'   Datumsangaben Zeile 22 ermitteln
        With Me.Range("B21")
            Me.Range("B22").Value = .Value
        End With
        
'  B14:B18 und E14:E18 sperren
        With Union(Range("B14:C18"), Range("E14:E18"))
            .Locked = True
            .Interior.Color = fLocked
        End With
        
'Formeln einfügen
        c = 1
        For r = 14 To 18
        c = c + 1
            Range("D" & r).FormulaLocal = "=SUMMENPRODUKT((Daten!D" & c & ":E9999>=B" & r & ")*(Daten!D" & c & ":D9999<=C" & r & ")*(Daten!E" & c & ":E9999))"
        Next r
        
        c = 1
        For r = 21 To 22
        c = c + 1
            Range("D" & r).FormulaLocal = "=SUMMENPRODUKT((Daten!D" & c & ":E9999>=B" & r & ")*(Daten!D" & c & ":D9999<=C" & r & ")*(Daten!E" & c & ":E9999))"
        Next r
        Application.EnableEvents = True
        
'  C21 und C22 entsperren, wenn B22 ein Datum enthält
        If Range("B22") <> "" And IsDate(Range("B22")) Then
            With Range("C21:C22")            'Eingabezellen entsperren und als Eingabezellen einfärben
                .Locked = False
                .Interior.Color = fUnLocked
                Range("C21").Select
            End With
        End If
    
' in C14 lag keine Eingabe vor
    Else                                'es wurden keine Daten eingegeben
        MsgBox "Es liegen keine Eingabedaten vor !" & Chr(10) & Chr(10) _
            & "Bitte Werte eingeben !", vbExclamation
    End If
            
End Sub

    
Private Sub CommandButton2_Click()
'========================================================================================
' Button 'Daten leeren'
'========================================================================================
    
'Eingabe- und Anzeigeblock: Inhalte löschen
    Application.EnableEvents = False
    Range("B14:C18").ClearContents
    Range("E14:E18").ClearContents
    Range("B21:C22").ClearContents
    Union(Range("D14:D18"), Range("D21:D22")).ClearContents
    Application.EnableEvents = True
    
'Eingabe- und Anzeigeblock: Zellen sperren und einfärben
    With Union(Range("C14"), Range("B15:C18"), Range("E14:E18")) 'die übrigen Eingabezeilen werden gesperrt
        .Locked = True
        .Interior.Color = fLocked
    End With
    With Range("B14")                           'die erste Eingabezelle wird entsperrt
        .Locked = False
        .Interior.Color = fUnLocked
        .Select
    End With
    With Range("C21:C22")                       'der Rest wird gesperrt
        .Locked = True
        .Interior.Color = fZeile2122
    End With
    
'Checkboxen in Grundstellung
    CheckBox1.Value = False
    CheckBox2.Value = False
    CheckBox3.Value = False
    CheckBox4.Value = False
    CheckBox5.Value = False
    CheckBox6.Value = False
    
End Sub
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.10.2018, 13:04   #10
LangerRafi
Neuer Benutzer
Neuer Benutzer
Tipp Zellem sperren/entsperren

Hallo,

ich habe folgendes Problem.

Ich habe mir eine Excel-Tabelle erstellt und nun möchte ich das nur bestimmte Zellen freigegeben werden, wenn in der Zelle zuvor ein Wer (Datum/Geschäftsvorfall oder der Betrag) eingegeben wird!

Beispiel:

Die Zellen "C14:F14" sind immer freigegeben, ich geben in "C14" das Datum des Geschäftsvorfalls ein (wenn kein richtiges Datum eingegeben wird, soll eine Meldung kommen, die aus der Tabelle "Einstellungen" in einer bestimmten Zelle steht, angezeigt werden) und in "D14" die Beschreibung des Geschäftsvorfalls und in "F14" den Betrag, wenn ich in "F14" den Betrag eingegeben habe, sollen die Zellen "C15:F15" freigegeben (entsperrt) werden und in die Zelle "C15" gesprungen werden. Dies soll aber nur bis "C316:F316" Zeile für Zeile möglich sein, am besten wäre es, wenn ich den Bereich definieren könnte, wieweit diese Prozedur funktionieren soll.

Im Umkehrschluss sollen die Zellen z. B. "C15:F15" erst dann gesperrt werden, wenn in den Zellen "C14:F14" nichts drin steht!

Nach Abschluss des Geschäftsjahres möchte ich gerne ein Button haben, mit der Beschriftung „Geschäftsjahr abschließen“ und dann sollen alle Zellen gesperrt werden, dass man nichts mehr ändern kann (am besten dann Password geschützt), und ein Button mit der Beschichtung „korrekter“ oder „bearbeiten“, damit ich ggf. Änderungen vornehmen kann, aber da muss ich selbst das Passwort eingeben!

Hoffe es ist verständlich was ich meine !?

Gruß Rafael
LangerRafi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 22.10.2018, 12:25   #11
LangerRafi
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

kann mir keiner HELFEN???
LangerRafi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 22.10.2018, 12:28   #12
Hajo_Zi
MOF Guru
MOF Guru
Standard

Solltest Du für Dein Problem nicht ein Extra Beitrag aufmachen?

Eine hochgeladene Arbeitsmappe erhöht die Wahrscheinlichkeit, dass Du eine Lösung für Dein Problem erhältst.

Erstelle folglich bitte eine Demomappe, aus der deine Aufgabenstellung klar erkennbar ist und lade diese Mappe mit einem aussagekräftigen Dateinamen hoch.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten anonymisieren bzw. pseudonymisieren.
Falls Du den Download des Forums nicht benutzen möchtest beachte bitte: von unsicheren Servern file-upload lade ich keine Datei herunter (lt. Einschätzung meines Virenprogramms).

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.

Im Forum kann der Beitrag als erledigt markiert werden. Also mache es unten links mit Klick auf den Schalter "als erledigt setzen", falls Problem gelöst.
Der Zustand des Beitrages wird dann in der Übersicht angezeigt und man braucht sich diese Beiträge nicht mehr ansehen.

GrußformelHomepage

__________________

Signatur in jedem Beitrag
m Forum kann der Beitrag als erledigt markiert werden. Also mache es unten links mit Klick auf den Schalter "als erledigt setzen", falls Problem gelöst.
Der Zustand des Beitrages wird dann in der Übersicht angezeigt und man braucht sich diese Beiträge nicht mehr ansehen.
Bitte Version angeben. Bei keiner Angabe gehe ich von meinen Angaben aus.
Betriebssystem: Windows 10 - 64 Bit, Office 2016 - 32 Bit.
Fragen werden im Forum beantwortet, nicht per PN.
Hajo_Zi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 25.10.2018, 12:05   #13
LangerRafi
Neuer Benutzer
Neuer Benutzer
Standard Bestimmter Bereich nacheinander entsperren

Ich dachte, da es mein Problem genau beschreibt, schreibe ich es hier drunter und erstelle kein neuen Beitrag!?

Ich habe mal eine Beispieltabelle erstellt.

Hoffe die ist verständlich!?
LangerRafi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.11.2018, 09:20   #14
LangerRafi
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

kann mir keiner HELFEN???
LangerRafi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.11.2018, 10:21   #15
erpe
MOF Profi
MOF Profi
Standard

Hallo,

nach vier Wochen noch keine Hilfe?
Woran das wohl liegt?
Beschreibung?

Nach drei Wochen kommt eine Datei,
bei der aber keinerlei Versuche unternommen wurden,
um deine Aufgabe zu lösen.
Die Tabelle Einstellungen fehlt auch.

Kopf und Hände in der Zwischenzeit außer Betrieb?

Wie von Hajo vorgeschlagen: einen Extra Beitrag aufmachen
Neue Mappe mit deinen eigenen Bemühungen hochladen inklusive einer besseren Beschreibung.

Dann könnte dein Wunsch in Erfüllung gehen.

Gruß
Rainer
erpe ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:53 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.