Makro nächsten Wert verdreifachen

[DartDidi]

Hallo,
habe mir im Bereich ab W28 im Tabellenblatt S1L1 mehrere Felder mit Makros erzeugt, die dann den jeweiligen Wert im Bereich E8:J27 reinschreiben.
Nun möchte ich gerne, dass wenn man vorher das Trippel oder Doppel ( die roten Felder) anklickt dann der jeweils nachfolgende Eingabe verdoppelt bzw. verdreifacht wird.
Also z.B. das Trippel und dann die 20, dann sollte im Bereich E8:J27 eine 60 erscheinen.
Würde mich über eine Lösung freuen.
Gruß und schon mal ein Danke im Voraus
Didi

[MisterBurns]

Hallo Didi,

der wesentlich einfachere Weg ist, zuerst die Zahl einzutragen und dann auf den Trippel-Button zu klicken. Das lässt sich mit einem Einzeiler lösen:

Code:

Selection.Value = Selection.Value * 3

BTW: Es ist höchst unübersichtlich, 14 Module in so eine Pipifaxdatei zu packen. Eines reicht ;)

[DartDidi]

Hallo Berni,
erstmal vielen Dank für dein bemühen.
Ich habe folgendes Projekt vor:
Es ist für ein Dartspiel gedacht. Bisher wurden die geworfenen Punkte über eine Funktastatur in den Eingabebereich E8:J27 eingetragen.
Die Dartscheibe besteht ja aus 20 Segmenten, also von 1 bis 20.
Diese können jeweils doppelt oder dreifach gewertet werden.
Ein Kumpel bekommt jetzt ein Tablet mit Windows und Excel drauf.
Das ganze soll nun auf diesem Tablet funktionieren.
Deshalb habe ich für jeden Wert von 1 bis 20 ein Makro zugeordnet, das ganze soll dann mal so wie eine Dartscheibe aussehen.
Wenn man dann z.B. eine 60 wirft dann wollte ich erst das Trippelfeld und dann die 20 tippen.
Gruß Didi

[MisterBurns]

Das war mir alles vorher schon klar, ändert aber nichts an meiner Aussage.

[DartDidi]

Hallo Berni,
so multipliziert er mir eine leere Zelle mit drei, ergibt Null.
Dann müsste man erst mal zurück in die vorherige Zelle kommen, diesen Wert dann multiplizieren und dann wieder weiter.
Gruß Didi

[MisterBurns]

Mit Strg+Enter bleibt der Cursor in der Eingabezelle.

Für den umgekehrten - komplizierteren - Weg musst du den Multiplikator durch den Buttonclick irgendwo hin schreiben, beispielsweise in eine Zelle in einem Hilfstabellenblatt. Dann führst du die Multiplikation aus und setzt danach den Multiplikator in der Hilfszelle auf 1. Über Worksheet_Change kannst du das für den benötigten Bereich automatisieren.

[DartDidi]

Hallo Berni noch mal,
habe mir jetzt die Zelle L19 auf 1 gesetzt.
Bei Trippel bzw. Doppel Button wird der Wert dann auf 3 bzw. 2 gesetzt.
Kann man dann den nachfolgenden Code so erweitern, dass er in diesem Beispiel zuerst den Wert 20 mit der Zelle L19 multipliziert und dann L19 wieder auf den Wert 1 setzt.
Das eine Beispiel würde mir schon reichen, der Code ist auch nicht mir, soweit reichen meine Excel-VBA-Kenntnisse noch nicht.
Sub Zwanzig()
' Zwanzig Makro
ActiveCell = 20
If ActiveCell.Column < 10 Then
  ActiveCell.Offset(0, 1).Select
  Else
  ActiveCell.Offset(1, -5).Select
  End If
End Sub


Gruß Didi

[MisterBurns]

1. Erstelle ein Tabellenblatt mit dem Namen "Hilfsblatt" und schreibe in Zelle A1 den Wert 1
2. Diese beiden Makros kommen in das Modul1

Code:

Sub Trippel()
Worksheets("Hilfsblatt").Cells(1, 1) = 3
End Sub

Sub Doppel()
Worksheets("Hilfsblatt").Cells(1, 1) = 2
End Sub

Den Buttons weist du dann das jeweilige Makro zu.

3. Dieser Code kommt in das Modul "DieseArbeitsmappe"

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "AusB" And Sh.Name <> "Hilfsblatt" And Sh.Name <> "Check" Then
    If Not Intersect(Target, Range("E8:J27")) Is Nothing Then
        Application.EnableEvents = False
        Target.Value = Target.Value * Worksheets("Hilfsblatt").Cells(1, 1)
        Worksheets("Hilfsblatt").Cells(1, 1) = 1
        Application.EnableEvents = True
    End If
End If
End Sub

---

Du erleichterst dir außerdem das Leben, wenn du für die einzelnen geworfenen Zahlenwert-Buttons den Code einkürzt. Der Teil mit der Abfrage der Cursorposition ist nur einmalig notwendig, ebenfalls alles in Modul1:

Code:

Sub Springen()
If ActiveCell.Column < 10 Then
    ActiveCell.Offset(0, 1).Select
Else
    ActiveCell.Offset(1, -5).Select
End If
End Sub

Sub Zwanzig()
ActiveCell = 20
Call Springen
End Sub

Sub Neunzehn()
ActiveCell = 19
Call Springen
End Sub

'usw. usw.

[DartDidi]

Hallo Berni,
erstmal ein Danke zu dir rüber, es funktioniert schon mal ganz gut so.
Es ist aber jetzt ein anderes Problem aufgetaucht.
Habe mir ein Button erstellt was zum Schluss wieder alles löschen soll.
(Makro den Bereich E8:J27 markiert dann auf Entfernen dann wieder in die Startzelle E8)
Beim Ausführen kommt dann die Meldung Laufzeitfehler 13  Typenunverträglichkeit.
Bei Debuggen ist dann folgendes Gelb markiert:
Target.Value=Target.Value*Workssheets("Hilfsblatt").Cells
Gibt es da vielleicht eine andere Möglichkeit den Bereich wieder zu löschen und den Cursor auf E8 zu setzen?
Gruß Didi

[MisterBurns]

Code in Modul1 und dann aus jedem gewünschten Blatt aufrufen

Code:

Public Sub Loeschen()

Application.EnableEvents = False
With ActiveSheet
    .Range("E8:J27").ClearContents
    .Range("E8").Select
End With
Application.EnableEvents = True

End Sub

Erweitere außerdem den Code in "DieseArbeitsmappe" wie folgt, dann kannst du auch händisch löschen, ohne einen Fehler zu produzieren

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "AusB" And Sh.Name <> "Hilfsblatt" And Sh.Name <> "Check" Then
    If Not Intersect(Target, Range("E8:J27")) Is Nothing Then
        If Target.Count = 1 Then
            Application.EnableEvents = False
            Target.Value = Target.Value * Worksheets("Hilfsblatt").Cells(1, 1)
            Worksheets("Hilfsblatt").Cells(1, 1) = 1
            Application.EnableEvents = True
        End If
    End If
End If
End Sub