338 Aufrufe
Gefragt in Tabellenkalkulation von addeguddi Experte (2.5k Punkte)
Hallo und einen schönen guten Tag an das Team vom Forum,

ich hätte da einmal Frage.

Ob das überhaupt möglich ist.

Habe als Beispiel eine Formel die so aussieht:

=WENN(UND(AO19=20;$J$1=11);"X";WENN(UND(AI19=20;$J$1=9);"X";WENN(UND(AC19=20;$J$1=7);"X";WENN(UND(W19=20;$J$1=5);"X";WENN(UND(Q19=20;$J$1=3);"X";WENN(UND(K19=20;$J$1=1);"X";20))))))

möchte jetzt, dass AO19, AI19 AC19,AC19;W19;Q19 und K19 einen festen Bezug erhalten ohne, dass ich jede Befehl anklicken muss. Da ich das für Ca 600 Zellen mal 6 anklicken müsste.

Für einen Tipp wäre ich sehr dankbar

Gruß Adde

14 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Adde,

was meinst du denn mit festem Bezug. Normalerweise verwendet man ja das $-Zeichen für feste Bezüge. Du kannst natürlich z.B. auch nur die Spalte (=$A1) oder Zeile (=A$1) festschreiben.

Gruß

M.O.
0 Punkte
Beantwortet von addeguddi Experte (2.5k Punkte)
Hallo M.O.

schön wieder einmal von dir zu hören. Zu meiner Frage:

Wenn du die oben genannte Formel anschaust siehst du; dass zum Beispiel J1 einen festen Bezug hat aber AO19 oder AI19 Usw.  nicht. Dieses möchte ich mit $ festen Bezug: Sollte dies nicht möglich sein muss ich leider alles einzeln anklicken.

Dein Vorschlag Spalte(=$A1) Kannst du mir bitte schreiben wo oder wie sich das eintragen.

Gruß Adde
+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Adde,

mit festem Spaltenbezug musst du einfach ein $ vor die Spaltenbezeichnungen machen, also statt AO19 schreibst du $AO19. Somit ist dann die Spalte festegelegt.

Du kannst es ja einfach mal in einem leeren Arbeitsblatt probieren.

Schreibe in Zelle B1 die Formel =$A1 und ziehe diese erst nach rechts und dann nach unten.

Dann kannst du das mit der Formel = A$1 probieren. Dann siehst du den Unterschied.

Gruß

M.O.
0 Punkte
Beantwortet von addeguddi Experte (2.5k Punkte)

Hallo M.O.

Nochmals vielen Dank für deine Antwort. Gestern stand ich ein wenig auf dem Schlauch. Habe dann erst verstanden was du geschrieben hast. Das war aber leider nicht was ich meinte.

Denn da müsste ich noch mehr Zellen erstellen.

Ich dachte, dass wenn in der Zelle diese Formel ohne festen Bezug eine Möglichkeit gibt alles auf einmal mit festen Bezug einzubinden die kein $ haben.

Das ist eine von vielen Formeln ohne 

=WENN(UND(AO19=20;$J$1=11);"X";WENN(UND(AI19=20;$J$1=9);"X";WENN(UND(AC19=20;$J$1=7);"X";WENN(UND(W19=20;$J$1=5);"X";WENN(UND(Q19=20;$J$1=3);"X";WENN(UND(K19=20;$J$1=1);"X";20))))))

Und ich wollte, dass es so erscheint, alle Bezüge von Zellen mit $ : wie unten angezeigt wird. Das ist jetzt für die Zahl 20.

=WENN(UND($AO$19=20;$J$1=11);"X";WENN(UND($AI$19=20;$J$1=9);"X";WENN(UND($AC$19=20;$J$1=7);"X";WENN(UND($W$19=20;$J$1=5);"X";WENN(UND($Q$19=20;$J$1=3);"X";WENN(UND($K$19=20;$J$1<>1);"X";20))))))

Da es wahrscheinlich keine Möglichkeit gibt, mache ich es händisch.

Gruß Adde

+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Adde,

du kannst es höchstens mal mit Suchen und Ersetzen versuchen.

Also z.B.

Suchen nach AO

Ersetzen durch $AO$

Das musst du dann aber leider für jede Spalte (also erst AO, dann AI usw.) machen, ist aber ggf. besser, als in jede Formel zu klicken. Und achte darauf, dass in den Optionen bei Suchen und Ersetzen suchen in Formeln ausgewählt ist.

Oder du kannst es mit einem Makro versuchen (hier mal für Spalte A, kannst du aber einfach anpassen):

Sub absolut()
Dim arrSpalten
Dim i As Integer

'Spaltenbezeichnungen die absolut adressiert werden sollen - ggf. anpassen
arrSpalten = Array("AO", "AI", "AC", "W", "Q", "K")

'Schleife für durchlaufen der Spaltenbezeichnungen
For i = LBound(arrSpalten) To UBound(arrSpalten)
    'durchsucht wird Spalte A; anpassen
    Columns("A:A").Replace What:=arrSpalten(i), Replacement:="$" & arrSpalten(i) & "$", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Next i
        
End Sub

Aber probiere es erst einmal in einer Testdatei aus.

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (2.5k Punkte)
Guten Morgen M.O.,

vielen lieben Dank für deine Antwort. Werde es mit suchen ersetzen machen.

Eine Frage habe ich noch, möchte diese aber nicht als neue Frage stellen, da ich schon mehrmals diesbezüglich gefragt habe und leider keine Antwort erhalten habe. Es geht um diese Datei die ich vom normalen Dartspiel in einer neue Spielvariante verändert habe und diese Dart Datei hast du mir einmal erstellt. Ich suche den Fehler und finde ihn nicht. es geht um die Einträge der Punkte. Für Spieler 1 Wurf 1 schreibt er K19 Wurf 2 in L19 Wurf 3 in M19 alles Ok. dann Spieler 2 von N19 auch Ok bis P19 jetzt ist Spieler 1 wieder am Wurf und dieser Wert wird in N19 übernommen anstatt in K19.

Wenn du möchtest, könntest du mir bei der Lösung helfen.

Das ist das VBA dazu

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect
Dim lngSpieler As Long
Dim lngSpalte As Long
Dim lngWurf As Long
Dim lngDT As Long
Dim strSpiel As String
Dim lngZeile As Long
Dim lngSZeile As Long
Dim lngWZeile As Long
Dim lngWSpalte As Long
Dim lngAnsage As Long
Dim bUeberw As Boolean
Dim i As Long

'Nur bei Klick im Bereich von K19 bis d12 ausführen
If Intersect(Target, Range("i2, H1, a2:d12")) Is Nothing Then Exit Sub

'nicht in Zelle klicken
Cancel = True

'Bei Klick in I2 = Game on - Ansage starten
If Target.Address = "$I$2" Then
  lngAnsage = 998
  'Ansage starten
  Start_Ansage (lngAnsage)
  'dann Makro wieder verlassen
  Exit Sub
End If

'Nummer des Spielers einlesen
lngSpieler = Range("j1").Value
 
'Spalte für Spieler ermitteln; Spieler stehen in Spalten K bis RB
lngSpalte = 8 + lngSpieler * 3
 
'Prüfen ob Zelle verbunden ist
If Target.Cells.Count > 1 Then
   'falls ja dann die entsprechenden Werte in Variable schreiben
    If Target.Address = "$f$12:$g$12" Then lngWurf = 25
    If Target.Address = "$f$12:$g$12" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    End If

         'prüfen, ob Fehlwurf
    If Target.Address = "$e$12:$f$12" Then lngWurf = 0
    
  Else
   'falls kein Fehlwurf
      lngWurf = Target.Value
      If Target.Column = 2 Or Target.Column = 5 Then lngDT = 2  'Marker für Doppel setzen
      If Target.Column = 3 Or Target.Column = 6 Then lngDT = 3   'Marker für Triple setze
End If
'wenn Überworfen,
If Cells(6, lngSpalte) - lngWurf < 0 Then
  'dann Wurfergebnis auf Null setzen
  lngWurf = 0
  'Marker für überworfen setzen
  bUeberw = True
End If

'wenn Überworfen, dann Wurfergebnis auf Null setzen
If Cells(6, lngSpalte) - lngWurf < 0 Then lngWurf = 0
 
'Zeile für Würfe suchen
'dazu die Nr des Spielers herausfinden und damit Suchstring erstellen
strSpiel = "Sp" & Range("J1")
 
'Zeile für Spiel suchen
For lngZeile = 19 To 442
  If Cells(lngZeile, 1).Value = strSpiel Then
    lngSZeile = lngZeile
    Exit For
  End If
Next lngZeile
'Zeile für Eintrag der Würfe suchen
lngWZeile = 19 + WorksheetFunction.RoundDown(Cells(lngSZeile, 10).Value / 3, 0)
   
'Spalte für den Eintrag der Würfe ermitteln
lngWSpalte = WorksheetFunction.RoundDown(Cells(lngSZeile, 10).Value / 3, 0) + 2
'Würfe der Runde auf Null setzen, wenn überworfen
If bUeberw = True Then
  For i = 1 To Cells(lngSZeile, lngWSpalte).Value
    Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - i) = 0
  Next i
  
End If

'Anzahl Würfe erhöhen
Cells(lngSZeile, lngWSpalte) = Cells(lngSZeile, lngWSpalte).Value + 1

'Anzahl Doppel erhöhen
If lngDT = 2 Then Cells(11, lngSpalte + 1) = Cells(11, lngSpalte + 1).Value + 1
'Anzahl Triple erhöhen
If lngDT = 3 Then Cells(11, lngSpalte + 2) = Cells(11, lngSpalte + 2).Value + 1

'Würfe eintragen
Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1) = lngWurf

'Daten für die Rücknahme des Wurfes in das Array schreiben
arrRueck(0) = lngSZeile                                            'Zeile für Eintrag des Wurfs
arrRueck(1) = lngWSpalte                                           'Spalte für Eintrag des Wurfs
arrRueck(2) = lngSpalte                                            'Spalte für Spieler
arrRueck(3) = lngWZeile                                            'Zeile für Ergebnis des Wurfs
arrRueck(4) = lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1   'Spalte für Ergebnis des Wurfes
arrRueck(5) = lngDT                                                'Doppel oder Triple

'hier für die Ansage und Anzeige
'prüfen, ob Überworfen
If bUeberw = True Then
  Start_Ansage (0)
Else
  'prüfen ob Anzahl der Würfe ohne Rest durch 3 Teilbar ist oder Checkout vorliegt
  If Cells(lngSZeile, lngWSpalte).Value Mod 3 = 0 And Cells(1, lngSpalte).Value <> "Checkout" Then
   'Anzeige
    Range("H6") = "Geworfen: " & Cells(arrRueck(3), arrRueck(4)).Value + Cells(arrRueck(3), arrRueck(4) - 2) + Cells(arrRueck(3), arrRueck(4) - 1) & vbLf & "Rest: " & Cells(6, arrRueck(4) - 2).Value
    lngAnsage = Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1) + Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 2) + Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 3)
    Start_Ansage (lngAnsage)
    'Anzeige nach 5 Sekunden wieder löschen
    Application.Wait Now + TimeValue("00:00:3")
    Range("H6") = ""
  End If
End If

'Checkout; 999 = Game over
If Cells(1, lngSpalte).Value = "Checkout" Then Start_Ansage (999)

If Not Intersect(Target, Range("B2:B11,E2:E12,C12")) Is Nothing Then
        'Doppel
        Cells(1 + Range("J1").Value, 422) = "ja"
    Else
        'kein Doppel
        Cells(1 + Range("J1").Value, 422) = "nein"
End If

ActiveSheet.Protect
End Sub

Gruß Adde
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Adde,

stelle doch bitte noch mal eine Beispieldatei zur Verfügung. Ich werde dann mal sehen, was ich machen kann.

Gruß

M.O.
0 Punkte
Beantwortet von addeguddi Experte (2.5k Punkte)

Hallo M.O.

Kurze Erläuterung zu diesem Spiel.

Von A2 bis D12 ist die Reihenfolge der Zahlen die getroffen werden müssen.

Von E2 bis E7 wird mit rechtem Mausklick die Runden Anzahl verändert

Von F2 bis F6 wird mit rechtem Mausklick die Zahlen 1 bis 5 und dann in G2 die Anzahl der Spieler angezeigt.

F2 =1 In G2 gleich 2 Spieler Usw.

In J1 wird die Reihenfolge der Spieler angezeigt. Diese Zahl wird über die Zellen RS8 , für 2 Spieler generiert. Mein Beispiel ist jetzt mit 3 Spieler und hier wird die Spielernummer aus RT8 eingepflegt.

Diese wird  anhand der Würfe ermittelt.

Die Spielernummer ändert sich immer nach 3 Würfe.

Am Wurf ist jetzt Spieler 1

Habe die Datei so gespeichert, das du, wenn du testest nur auf die Zahl 9 mit Doppelklick anfangen kannst.

Diese Zahl ( 9 ) sollte in der Zelle K20 erscheinen doch sie wird in N19 eingetragen und von der Summe in N5 abgezogen.

Bitte wundere dich nicht über diese Datei bin noch nicht ganz fertig.

Solltest du es hinkriegen wäre auch nicht schlimm, dann werde ich das alles löschen.

Datei habe ich hochgeladen:

https://filehorst.de/d/eigAgqiw

Gruß Adde

+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Adde,

hier das angepasste Makro:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect
Dim lngSpieler As Long
Dim lngSpalte As Long
Dim lngWurf As Long
Dim lngDT As Long
Dim strSpiel As String
Dim lngZeile As Long
Dim lngSZeile As Long
Dim lngWZeile As Long
Dim lngWSpalte As Long
Dim lngAnsage As Long
Dim bUeberw As Boolean
Dim i As Long

'Nur bei Klick im Bereich von K19 bis d12 ausführen
If Intersect(Target, Range("i2, H1, a2:d12")) Is Nothing Then Exit Sub

'nicht in Zelle klicken
Cancel = True

'Bei Klick in I2 = Game on - Ansage starten
If Target.Address = "$I$2" Then
  lngAnsage = 998
  'Ansage starten
  Start_Ansage (lngAnsage)
  'dann Makro wieder verlassen
  Exit Sub
End If

'Nummer des Spielers einlesen
lngSpieler = Range("j1").Value
 
'Spalte für Spieler ermitteln; Spieler stehen in Spalten K bis RB
lngSpalte = 8 + lngSpieler * 3
 
'Prüfen ob Zelle verbunden ist
If Target.Cells.Count > 1 Then
   'falls ja dann die entsprechenden Werte in Variable schreiben
    If Target.Address = "$f$12:$g$12" Then lngWurf = 25
    If Target.Address = "$f$12:$g$12" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    End If

         'prüfen, ob Fehlwurf
    If Target.Address = "$e$12:$f$12" Then lngWurf = 0
    
  Else
   'falls kein Fehlwurf
      lngWurf = Target.Value
      If Target.Column = 2 Or Target.Column = 5 Then lngDT = 2  'Marker für Doppel setzen
      If Target.Column = 3 Or Target.Column = 6 Then lngDT = 3   'Marker für Triple setze
End If
'wenn Überworfen,
If Cells(6, lngSpalte) - lngWurf < 0 Then
  'dann Wurfergebnis auf Null setzen
  lngWurf = 0
  'Marker für überworfen setzen
  bUeberw = True
End If

'wenn Überworfen, dann Wurfergebnis auf Null setzen
If Cells(6, lngSpalte) - lngWurf < 0 Then lngWurf = 0
 
'Zeile für Würfe suchen
'dazu die Nr des Spielers herausfinden und damit Suchstring erstellen
strSpiel = "Sp" & Range("J1")
 
'Zeile für Spiel suchen
For lngZeile = 19 To 442
  If Cells(lngZeile, 1).Value = strSpiel Then
    lngSZeile = lngZeile
    Exit For
  End If
Next lngZeile
'Zeile für Eintrag der Würfe suchen
lngWZeile = 19 + WorksheetFunction.RoundDown(Cells(lngSZeile, 2).Value / 3, 0)
   
'Spalte für den Eintrag der Würfe ermitteln
lngWSpalte = WorksheetFunction.RoundDown(Cells(lngSZeile, 2).Value / 3, 0) + 2
'Würfe der Runde auf Null setzen, wenn überworfen
If bUeberw = True Then
  For i = 1 To Cells(lngSZeile, lngWSpalte).Value
    Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - i) = 0
  Next i
 
End If

'Anzahl Würfe erhöhen
Cells(lngSZeile, 2) = Cells(lngSZeile, 2).Value + 1

'Anzahl Doppel erhöhen
If lngDT = 2 Then Cells(11, lngSpalte + 1) = Cells(11, lngSpalte + 1).Value + 1
'Anzahl Triple erhöhen
If lngDT = 3 Then Cells(11, lngSpalte + 2) = Cells(11, lngSpalte + 2).Value + 1

'Würfe eintragen
'Rest aus Anzahl der Würfe ermitteln und dann ent
Select Case Cells(lngSZeile, 2).Value Mod 3
  Case Is = 0
    'kein Rest, also 3. Wurf
    Cells(lngWZeile, lngSpalte + 2) = lngWurf
  Case Is = 1
    'Rest 1, also 1. Wurf
    Cells(lngWZeile, lngSpalte) = lngWurf
  Case Is = 2
    'Rest 2, also 2. Wurf
     Cells(lngWZeile, lngSpalte + 1) = lngWurf
 End Select

'Daten für die Rücknahme des Wurfes in das Array schreiben
arrRueck(0) = lngSZeile                                            'Zeile für Eintrag des Wurfs
arrRueck(1) = lngWSpalte                                           'Spalte für Eintrag des Wurfs
arrRueck(2) = lngSpalte                                            'Spalte für Spieler
arrRueck(3) = lngWZeile                                            'Zeile für Ergebnis des Wurfs
arrRueck(4) = lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1   'Spalte für Ergebnis des Wurfes
arrRueck(5) = lngDT                                                'Doppel oder Triple

'hier für die Ansage und Anzeige
'prüfen, ob Überworfen
If bUeberw = True Then
  Start_Ansage (0)
Else
  'prüfen ob Anzahl der Würfe ohne Rest durch 3 Teilbar ist oder Checkout vorliegt
  If Cells(lngSZeile, lngWSpalte).Value Mod 3 = 0 And Cells(1, lngSpalte).Value <> "Checkout" Then
   'Anzeige
    Range("H6") = "Geworfen: " & Cells(arrRueck(3), arrRueck(4)).Value + Cells(arrRueck(3), arrRueck(4) - 2) + Cells(arrRueck(3), arrRueck(4) - 1) & vbLf & "Rest: " & Cells(6, arrRueck(4) - 2).Value
    lngAnsage = Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1) + Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 2) + Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 3)
    Start_Ansage (lngAnsage)
    'Anzeige nach 5 Sekunden wieder löschen
    Application.Wait Now + TimeValue("00:00:3")
    Range("H6") = ""
  End If
End If

'Checkout; 999 = Game over
If Cells(1, lngSpalte).Value = "Checkout" Then Start_Ansage (999)

If Not Intersect(Target, Range("B2:B11,E2:E12,C12")) Is Nothing Then
        'Doppel
        Cells(1 + Range("J1").Value, 422) = "ja"
    Else
        'kein Doppel
        Cells(1 + Range("J1").Value, 422) = "nein"
End If

ActiveSheet.Protect
End Sub

Bei meinen Tests wurden die Würfe jetzt in die richtige Zeile und Spalte geschrieben.

Hier der Link zur bearbeiteten Datei: Download

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (2.5k Punkte)
Hallo M.O.,

TOP - LEISTIUNG:

Vielen lieben Dank für deine Unterstützung. Du bist der BESTE. Du hat sogar das mit den Würfe integriert. Ich kann das nur mit Formeln erreichen.

Habe testweise ausprobiert. Morgen teste ich nochmal alles, denke aber das alles klappt.

Gruß Adde
...