Bir Hücredeki Sayıyı Arttırırken Diğer Hücredekini Azaltmak (SKORBORD)

[MOSAD]

Merhabalar. Bilardo ile ilgili bir skorbord oluşturmaktayım.
Excel tablosunda bir hücrede oyunun puanını bizden alacak. Örneğin 30 puan başlangıç puanı olacak.
4 oyuncunun hücresinde otomatik olarak 30 yazacak.
Her oyuncunun adının altında yada skor göstergesinde arttırma butonu olacak (sadece arttırma olacak).
Örneğin 1. oyuncunun arttırma puanına bastığımda diğer oyunculardan 1 puan düşecek ve 2. oyuncunun hanesine 3 puan eklenecek.

Biraz karışık anlatmış olabilirim kusura bakmayın. Formüle etmeye çalıştım fakat işin içinden çıkamadım. Bir yol gösteren olursa sevinirim.

 

[MOSAD]

Şöyle çözdüm sorunumu; çift tıkladığımda oyuncunun skoruna otomatik olarak 3 artıp diğerleri 1 eksiliyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

On Error Resume Next
    If Not Intersect(Target, Range("C7")) Is Nothing Then
      Range("C7").Value = Range("C7").Value + 3
      Range("E7").Value = Range("E7").Value - 1
      Range("G7").Value = Range("G7").Value - 1
      Range("I7").Value = Range("I7").Value - 1
      Cancel = True
    End If
    
On Error Resume Next
    If Not Intersect(Target, Range("E7")) Is Nothing Then
      Range("E7").Value = Range("E7").Value + 3
      Range("C7").Value = Range("C7").Value - 1
      Range("G7").Value = Range("G7").Value - 1
      Range("I7").Value = Range("I7").Value - 1
      Cancel = True
    End If
    
On Error Resume Next
    If Not Intersect(Target, Range("G7")) Is Nothing Then
      Range("G7").Value = Range("G7").Value + 3
      Range("C7").Value = Range("C7").Value - 1
      Range("E7").Value = Range("E7").Value - 1
      Range("I7").Value = Range("I7").Value - 1
      Cancel = True
    End If
    
On Error Resume Next
    If Not Intersect(Target, Range("I7")) Is Nothing Then
      Range("I7").Value = Range("I7").Value + 3
      Range("C7").Value = Range("C7").Value - 1
      Range("G7").Value = Range("G7").Value - 1
      Range("E7").Value = Range("E7").Value - 1
      Cancel = True
    End If
    
End Sub

 

[çıtır]

Bende şöyle bir dosya hazırlamıştım.
https://www.dosyaupload.com/rGfP

 

[MOSAD]

Benim hazırladığımı denemek ve görmek isteyenler buyrun;
https://www.dosyaupload.com/rGfW