değer artırma

[HerAsFiGoWa]

örnek tablo görsel yükledim,
burada, sarı kutudaki ismi listeden bulup karşısındaki değeri mavi kutu kadar artırsın istiyorum

 

[Muzaffer Ali]

Merhaba.

Tablonuzun bulunduğu sayfanın kod sayfasına aşağıdaki kodu kopyalayın.
İsim yazdığınız hücrede bir değişiklik olduğunda istediğiniz işlem otomatik gerçekleşecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Isimler As Range
    Dim Isim As Range
    Dim Rakam As Range
    Dim Bul As Range
    
    Set Isimler = Range("A:A") ' İsim listesinin bulunduğu kolon
    Set Isim = Range("E1") 'İsim yazacağınız hücre
    Set Rakam = Range("E2") ' Rakam yazacağınız hücre
    
    
    If Not Intersect(Target, Isim) Is Nothing Then
        Set Bul = Isimler.Find(what:=Target.Text, lookat:=xlWhole)
        If Bul Is Nothing Then
            MsgBox "Aradığınız isim bulunamadı."
            Exit Sub
        End If
        Bul.Offset(0, 1) = Bul.Offset(0, 1) + Rakam
    End If
End Sub

Kodlardaki aşağıdaki kısmı kendinize göre düzeltin.

    Set Isimler = Range("A:A") ' İsim listesinin bulunduğu kolon
    Set Isim = Range("E1") 'İsim yazacağınız hücre
    Set Rakam = Range("E2") ' Rakam yazacağınız hücre

 

[HerAsFiGoWa]

Merhaba.

Tablonuzun bulunduğu sayfanın kod sayfasına aşağıdaki kodu kopyalayın.
İsim yazdığınız hücrede bir değişiklik olduğunda istediğiniz işlem otomatik gerçekleşecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Isimler As Range
    Dim Isim As Range
    Dim Rakam As Range
    Dim Bul As Range
   
    Set Isimler = Range("A:A") ' İsim listesinin bulunduğu kolon
    Set Isim = Range("E1") 'İsim yazacağınız hücre
    Set Rakam = Range("E2") ' Rakam yazacağınız hücre
   
   
    If Not Intersect(Target, Isim) Is Nothing Then
        Set Bul = Isimler.Find(what:=Target.Text, lookat:=xlWhole)
        If Bul Is Nothing Then
            MsgBox "Aradığınız isim bulunamadı."
            Exit Sub
        End If
        Bul.Offset(0, 1) = Bul.Offset(0, 1) + Rakam
    End If
End Sub

Kodlardaki aşağıdaki kısmı kendinize göre düzeltin.

    Set Isimler = Range("A:A") ' İsim listesinin bulunduğu kolon
    Set Isim = Range("E1") 'İsim yazacağınız hücre
    Set Rakam = Range("E2") ' Rakam yazacağınız hücre

WALLA NE DİYEYİM, NASIL TEŞEKKÜR EDEYİM BİLEMİYORUM... KOD, TIKIR TIKIR ÇALIŞIYOR
EMEĞİNE SAĞLIK
ALLAH SENDEN, 1000 KERE RAZI OLSUN...

 

[Muzaffer Ali]

Ben teşekkür ederim. Allah senden de razı olsun.