Geht das auch rückwärts ?

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Geht das auch rückwärts ? von: Werner
Geschrieben am: 23.03.2005 10:32:52

Hallo,
mit folgendem Code

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$E$5" Then Exit Sub
   Application.EnableEvents = False
   Range("A1:A14").Copy
   Range("A2").PasteSpecial (xlPasteValues)
   Range("A1") = Target
   With Range("E5")
      .Value = ""
      .Select
   End With
   Application.EnableEvents = True
End Sub



wird erreicht, das die in E5 eingegebene Zahl immer in die Zelle A1 übernommen wird und die darunterliegenden eine Zelle nach unten "rutschen".

Jetzt möchte ich folgendes erreichen: Wenn in E5 die Zahl 999 eingegeben wird, soll diese nicht in A1 übernommen werden, sondern die Zahl aus A1 soll gelöscht werden und die darunter stehenden eins "nach ober rutschen". Das ganze dient als Korrekturmöglichkeit, wenn einmal eine falsche Zahl eingegeben wurde.

Um einen Großteil der Fehleingaben von vornherein zu vermindern, wäre es toll, wenn man zusätzlich erreichen könnte, das nur dreistellige Zahlen eingegeben werden können.

Außerdem sollten nur Zahlen eingegeben werden können, deren Quersumme kleiner als 19 ist, außer wenn die Zahl 777, 888 oder eben 999 ist.

Bei einer Falscheingabe (nicht dreistellig oder Quersumme > 18 (außer 777, 888, 999)) sollte E5 automatisch geleert und selektiert werden.

Kann mir jemand bei diesem Problem einen Lösungsweg verraten?

HILFE !!!

Gruß

Werner
Bild


Betrifft: AW: Geht das auch rückwärts ? von: Tobias Marx
Geschrieben am: 23.03.2005 10:48:34

Servus!

So sollte auf jeden Fall mal das mit der "999" klappen:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address <> "$E$5" Then Exit Sub
  If Range("E5").Value <> "999" Then
   Application.EnableEvents = False
   Range("A1:A14").Copy
   Range("A2").PasteSpecial (xlPasteValues)
   Range("A1") = Target
   With Range("E5")
      .Value = ""
      .Select
   End With
   Application.EnableEvents = True
  Else
   Application.EnableEvents = False
   Range("A1").Cut
   Range("A2:A14").Copy
   Range("A1").PasteSpecial (xlPasteValues)
   Range("A1") = Target
   Range("A14").Delete
   With Range("E5")
      .Value = ""
      .Select
   End With
End Sub


Gruss

Tobias


Bild


Betrifft: AW: Geht das auch rückwärts ? von: Andi
Geschrieben am: 23.03.2005 11:06:04

Hi Werner,

da müsste jetzt eigentlich alles drin sein:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Zaehler As Integer
  Dim Quersumme As Integer
   If Target.Address <> "$E$5" Then Exit Sub
   If Len(Target.Value) <> 3 Then
    MsgBox "Bitte geben Sie eine 3-stellige Zahl ein"
    Application.EnableEvents = False
    With Range("E5")
        .Value = ""
        .Select
        End With
    Application.EnableEvents = True
    Exit Sub
   End If
   Select Case Target.Value
    Case 777, 888
    Case 999
      Application.EnableEvents = False
      Range("a2:a15").Copy
      Range("A1").PasteSpecial (xlPasteValues)
      With Range("E5")
      .Value = ""
      .Select
      End With
      Application.EnableEvents = True
      Exit Sub
      Case Else
      Quersumme = 0
      For Zaehler = 1 To 3
      Quersumme = Quersumme + Val(Mid(Target.Value, Zaehler, 1))
      Next Zaehler
      If Quersumme < 19 Then
        MsgBox "ungültige Quersumme"
        Application.EnableEvents = False
        With Range("E5")
        .Value = ""
        .Select
        End With
        Application.EnableEvents = True
        Exit Sub
      End If
    End Select
    Application.EnableEvents = False
   Range("A1:A14").Copy
   Range("A2").PasteSpecial (xlPasteValues)
   Range("A1") = Target
   With Range("E5")
      .Value = ""
      .Select
   End With
   Application.EnableEvents = True
End Sub


Geht wahrscheinlich auch weniger umständlich, aber ich hab das jetzt schrittweise programmiert, und dabei ist eben das rausgekommen...

Schönen Gruß,
Andi


Bild


Betrifft: AW: Geht das auch rückwärts ? von: WernerB.
Geschrieben am: 23.03.2005 12:43:35

Hallo Namensvetter,

wie gefällt Dir das?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte, s As Byte, _
    check As Boolean
    If Target.Address <> "$E$5" Then Exit Sub
    Application.EnableEvents = False
    If Application.IsNumber(Target.Value) = False Then
      MsgBox "Keine numerische Eingabe !" & vbCr & vbCr & "Makro-Abbruch !", _
        vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
      GoTo ErrorHandler
    End If
    Select Case Target.Value
      Case 777, 888
        check = True
      Case 999
        Range("A1:A14").Value = Range("A2:A15").Value
        Range("A15").ClearContents
      Case Else
        If Len(Target.Text) = 3 Then
          For i = 1 To 3
            s = s + Mid(Target.Text, i, 1)
          Next i
          If s < 19 Then
            check = True
          Else
            MsgBox "Unzulässiger Wert !" & vbCr & vbCr & "Makro-Abbruch !", _
              vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
            GoTo ErrorHandler
          End If
        Else
          MsgBox "Dreistellige Zahl erwartet !" & vbCr & vbCr & "Makro-Abbruch !", _
            vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
          GoTo ErrorHandler
        End If
    End Select
    If check = True Then
      Range("A2:A15").Value = Range("A1:A14").Value
      Range("A1") = Target.Value
      With Range("E5")
        .Value = ""
        .Select
      End With
    End If
ErrorHandler:
      With Range("E5")
        .Value = ""
        .Select
      End With
    Application.EnableEvents = True
End Sub

Viel Erfolg wünscht
WernerB.

P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !


Bild


Betrifft: AW: Geht das auch rückwärts ? von: Werner
Geschrieben am: 23.03.2005 13:10:42

Hallo Werner,

herzlichen Dank soweit, es funktioniert alles ganz wunderbar, ich bin begeistert. Ich habe das Makro sogar begriffen.
Wie du dir sicher schon gedacht hast, geht es bei dieser Tabelle um Würfel, jetzt habe ich im Test noch ein Problem festgestellt, welches ich nicht lösen kann:
Da auf einem Würfel nur Zahlen von 1 bis 6 vorhanden sind, sollte natürlich auch ein Abbruch erfolgen, wenn die Ziffern 7, 8, 9, oder 0 vorkommen, es sei denn in den Kombinationen 777, 888, 999 oder 000, die Steuerungsfunktionen haben.

Also nochmals vielen Dank (und vielleicht bastelst du noch etwas weiter?)

Gruß

Werner


Bild


Betrifft: AW: Geht das auch rückwärts ? von: WernerB.
Geschrieben am: 23.03.2005 14:01:49

Hallo Werner,

für die Eingabe von "000" muss die Eingabezelle benutzerdefiniert mit "000" formatiert sein.
Dann sollte es so laufen:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte, s As Byte, _
    check As Boolean
    If Target.Address <> "$E$5" Then Exit Sub
    Application.EnableEvents = False
    If Application.IsNumber(Target.Value) = False Then
      MsgBox "Keine numerische Eingabe !" & vbCr & vbCr & "Makro-Abbruch !", _
        vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
      GoTo ErrorHandler
    End If
    Select Case Target.Text
      Case "777", "888", "000"
        check = True
      Case 999
        Range("A1:A14").Value = Range("A2:A15").Value
        Range("A15").ClearContents
      Case Else
        If Len(Target.Text) = 3 Then
          For i = 1 To 3
            s = s + Mid(Target.Text, i, 1)
          Next i
          If InStr(Target.Text, "7") > 0 Then s = 99
          If InStr(Target.Text, "8") > 0 Then s = 99
          If InStr(Target.Text, "9") > 0 Then s = 99
          If InStr(Target.Text, "0") > 0 Then s = 99
          If s < 19 Then
            check = True
          Else
            MsgBox "Unzulässiger Wert !" & vbCr & vbCr & "Makro-Abbruch !", _
              vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
            GoTo ErrorHandler
          End If
        Else
          MsgBox "Dreistellige Zahl erwartet !" & vbCr & vbCr & "Makro-Abbruch !", _
            vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
          GoTo ErrorHandler
        End If
    End Select
    If check = True Then
      Range("A2:A15").Value = Range("A1:A14").Value
      Range("A1") = Target.Value
      With Range("E5")
        .Value = ""
        .Select
      End With
    End If
ErrorHandler:
      With Range("E5")
        .Value = ""
        .Select
      End With
    Application.EnableEvents = True
End Sub

Gruß
WernerB.


Bild


Betrifft: AW: Geht das auch rückwärts ? von: Werner
Geschrieben am: 23.03.2005 16:47:10

DANKE DANKE DANKE

Das funktioniert ja großartig, ich bin begeistert.
Du hast sicher aus der Tatsache, das es sich um ein Würfelproblem handelt und aus meiner eMail-Adresse schon messerscharf geschlossen, wo Deine Hilfe zum Einsatz kommen wird.
Wenn Du mir deine Mailadresse mitteilst, werde ich dich selbstverständlich mal in unsere Spielbank einladen, wo Du dein Werk dann im Einsatz bewundern kannst.

Gruß aus Schleswig-Holstein

Werner (casino@foni.net)


Bild


Betrifft: AW: Geht das auch rückwärts ? von: WernerB.
Geschrieben am: 24.03.2005 07:15:14

Hallo Werner,

vielen Dank für das gut gemeinte Angebot zum Besuch der Spielbank.
Wenn ich es bedauerlicherweise nicht annehmen kann, so liegt dies daran, dass ich mir zum einen nichts aus Spielen mache (nicht mal aus PC-Spielen) und zum andern, weil die räumliche Entfernung zwischen unseren Wohnorten nicht ganz unerheblich ist.
Es ist zudem höchst unwahrscheinlich, dass ich in absehbarer zeit mal zufällig nach Schleswig-Holstein kommen werde.


Frohe Ostern wünscht
WenerB.


Bild


Betrifft: AW: Geht das auch rückwärts ? von: Werner
Geschrieben am: 24.03.2005 13:30:52

Hallo Werner,

da Du leider nicht die Zeit findest, nach Norddeutschland zu kommen, hast Du vielleicht die Zeit,mir einen Tipp zu geben, wie ich in "unserer" Tabelle (auf einem anderen Blatt) eine Art Datenbank aufbauen kann, in der alle eingegebenen Zahlen (die dreistelligen) der Reihe nach erfasst werden, um danach einige Berechnungen und Statistiken damit durchführen zu können. Die Zahlen sollten mit dazugehörigem Datum/Uhrzeit in einer Tabelle erfasst werden.
Das größte Problem scheint mir dabei zu sein, dass die Zahlen, die über die "999" Funktion wieder gelöscht werden, auch aus der "Datenbank" wieder verschwinden sollten.

Also, wenn Du Zeit und Lust hast (und alle Ostereier gefunden hast), kannst Du Dir ja mal ein paar Gedanken machen, es würde mir sehr helfen.

Gruß aus dem hohen Norden, frohe Ostern

Werner


Bild


Betrifft: AW: Geht das auch rückwärts ? von: WernerB.
Geschrieben am: 24.03.2005 17:49:37

Hallo Werner,

wenn das letzte Blatt in Deiner Mappe die Datenbank ist, dann wird dort in der Spalte "A" die Zahl, in der Spalte "B" das Datum und in Spalte "C" die Uhrzeit eingetragen.

Diese beiden Makros gehören in ein normales Standard-Modul:


Sub DBKplus()
Dim laR As Long
With Sheets(Sheets.Count)
laR = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(laR + 1, 1).Value = Range("A1").Value
.Cells(laR + 1, 2).Value = Date
.Cells(laR + 1, 3).Value = Time
End With
End Sub
Sub DBKminus()
Dim laR As Long
With Sheets(Sheets.Count)
laR = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(laR, 1), .Cells(laR, 3)).ClearContents
End With
End Sub
Dieses Makro gehört in das Tabellenblatt-Modul des Eingabe-Blattes:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte, s As Byte, _
    check As Boolean
    If Target.Address <> "$E$5" Then Exit Sub
    Application.EnableEvents = False
    If Application.IsNumber(Target.Value) = False Then
      MsgBox "Keine numerische Eingabe !" & vbCr & vbCr & "Makro-Abbruch !", _
        vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
      GoTo ErrorHandler
    End If
    Select Case Target.Text
      Case "777", "888", "000"
        check = True
      Case 999
        Range("A1:A14").Value = Range("A2:A15").Value
        Range("A15").ClearContents
        Call DBKminus
      Case Else
        If Len(Target.Text) = 3 Then
          For i = 1 To 3
            s = s + Mid(Target.Text, i, 1)
          Next i
          If InStr(Target.Text, "7") > 0 Then s = 99
          If InStr(Target.Text, "8") > 0 Then s = 99
          If InStr(Target.Text, "9") > 0 Then s = 99
          If InStr(Target.Text, "0") > 0 Then s = 99
          If s < 19 Then
            check = True
          Else
            MsgBox "Unzulässiger Wert !" & vbCr & vbCr & "Makro-Abbruch !", _
              vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
            GoTo ErrorHandler
          End If
        Else
          MsgBox "Dreistellige Zahl erwartet !" & vbCr & vbCr & "Makro-Abbruch !", _
            vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
          GoTo ErrorHandler
        End If
    End Select
    If check = True Then
      Range("A2:A15").Value = Range("A1:A14").Value
      Range("A1") = Target.Value
      Call DBKplus
    End If
ErrorHandler:
      With Range("E5")
        .ClearContents
        .Select
      End With
    Application.EnableEvents = True
End Sub

Viel Erfolg wünscht
WernerB.


Bild


Betrifft: AW: Geht das auch rückwärts ? von: Werner
Geschrieben am: 25.03.2005 17:46:42

Herzlichen Dank, es klappt großartig!

Gruß
Werner


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Autofilter-Ergebniss kopieren"