Herbers Excel-Forum - das Archiv

Geht das auch rückwärts ?

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