makro ile koşul

[attrd]

iyi günler arkadaşlar makro ile SAYFA3 de
A1 hücresinde sayı var ise D1 hücresindeki sayıya 12 eklesin , A1 hücresindeki sayıyı silince D1 e eklediği 12 yi geri cıkarsın
A2 hücresinde sayı var ise D2 hücresindeki sayıya 13 eklesin , A2 hücresindeki sayıyı silince D2 e eklediği 13 yi geri cıkarsın
A3 hücresinde sayı var ise D3 hücresindeki sayıya 16 eklesin , A3 hücresindeki sayıyı silince D3 e eklediği 16 yi geri cıkarsın

makro ile yapabilirmiyiz A Hücrelerine sayı yazınca veya silinde makro otomatik çalışşın
Yardımcı olabilirseniz sevinirim simdiden teşekür ederim

 

[ÖmerFaruk]

bahsettiğiniz 12-13-16... gibi sayıların bir kuralı var mıdır?

 

[attrd]

bahsettiğiniz 12-13-16... gibi sayıların bir kuralı var mıdır?

Ömer bey sayıların kuralı yok onları daha sonra ben kod yerinden değiştireceğim

 

[ÖmerFaruk]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A3")) Is Nothing Then Exit Sub
    ReDim Liste(1 To 3)
    Liste(1) = 12
    Liste(2) = 13
    Liste(3) = 16
    If IsEmpty(Target) Then
        Target.Offset(, 3) = Target.Offset(, 3) - Liste(Target.Row)
    Else
        Target.Offset(, 3) = Target.Offset(, 3) + Liste(Target.Row)
    End If
End Sub

 

[attrd]

ÖMER Hocam cok teşekkür ederim elinize sağlık, peki ben A1 A2 A3 YERİNE C1 B2 E5 diye değiştirsem ve D1 D2 D3 yerinede diyelimki C1 e K3,, B2 ye M7 ve E5 ide R8 diye bu hücrelere uygulasam formulde nasıl değişiklik yapmalıyım

 

[attrd]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A3")) Is Nothing Then Exit Sub
    ReDim Liste(1 To 3)
    Liste(1) = 12
    Liste(2) = 13
    Liste(3) = 16
    If IsEmpty(Target) Then
        Target.Offset(, 3) = Target.Offset(, 3) - Liste(Target.Row)
    Else
        Target.Offset(, 3) = Target.Offset(, 3) + Liste(Target.Row)
    End If
End Sub

ÖMER Hocam cok teşekkür ederim elinize sağlık, peki ben A1 A2 A3 YERİNE C1 B2 E5 diye değiştirsem ve D1 D2 D3 yerinede diyelimki C1 e K3,, B2 ye M7 ve E5 ide R8 diye bu hücrelere uygulasam formulde nasıl değişiklik yapmalıyım

 

[attrd]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A3")) Is Nothing Then Exit Sub
    ReDim Liste(1 To 3)
    Liste(1) = 12
    Liste(2) = 13
    Liste(3) = 16
    If IsEmpty(Target) Then
        Target.Offset(, 3) = Target.Offset(, 3) - Liste(Target.Row)
    Else
        Target.Offset(, 3) = Target.Offset(, 3) + Liste(Target.Row)
    End If
End Sub

yani hücreleri farklı farklı değiştirebileyim

 

[ÖmerFaruk]

Sorunuzu başta doğru şekilde tanımlarsanız biz de çözümü ona göre sizin de kolaylıkla hakim olabileceğiniz şekilde oluşşturabiliriz.
Verdiğim kodu bahsettiğiniz şekle uyduramazsınız.
Yeniden yazmak şart.

 

[attrd]

kusura bakmayın hocam benim hatam affola

 

[ÖmerFaruk]

Verdiğiniz adresler net midir? Farklı sayfada farklı dosyada farklı mı olacaktır?

 

[attrd]

Verdiğiniz adresler net midir? Farklı sayfada farklı dosyada farklı mı olacaktır?

adresler net değil hocam aynı sayılar gibi kod sayfasına girince değiştirebilmeliyim

 

[ÖmerFaruk]

.Add ile başlayan satırlarda
$A$1 olan ilk kısım Kaynak yani elle veri girdiğiniz yerler
$D$1 olan ikinci kısmın ilk parçası toplanacak ya da çıkarılacak hücreler
12 olan ikinci kısmın ikinci parçası ekleyecek ya da çıkaracağınız sayılar
Aradaki tire(-) işaretine dokunmayın. Tire öncesine ve sonrasına boşluk bırakmayın.
Arzu ederseniz ilave .Add yazarak yeni hücreler ekleyebilirsiniz. Ben sadece örnek 3 tane ekledim.

Private Sub Worksheet_Change(ByVal Target As Range)
    With CreateObject("Scripting.Dictionary")
        .Add "$A$1", "$D$1-12" 'A1 hücresi değişince D1 hücresine 12 ekleyecek ya da ilave edecek
        .Add "$A$2", "$D$2-13"
        .Add "$B$5", "$F$8-14"
        If .Exists(Target.Address) Then
            If Target = "" Then İslem = -1 Else İslem = 1
            Range(Split(.Item(Target.Address), "-")(0)) = Range(Split(.Item(Target.Address), "-")(0)) + İslem * Split(.Item(Target.Address), "-")(1)
        End If
    End With
End Sub

 

[attrd]

.Add ile başlayan satırlarda
$A$1 olan ilk kısım Kaynak yani elle veri girdiğiniz yerler
$D$1 olan ikinci kısmın ilk parçası toplanacak ya da çıkarılacak hücreler
12 olan ikinci kısmın ikinci parçası ekleyecek ya da çıkaracağınız sayılar
Aradaki tire(-) işaretine dokunmayın. Tire öncesine ve sonrasına boşluk bırakmayın.
Arzu ederseniz ilave .Add yazarak yeni hücreler ekleyebilirsiniz. Ben sadece örnek 3 tane ekledim.

Private Sub Worksheet_Change(ByVal Target As Range)
    With CreateObject("Scripting.Dictionary")
        .Add "$A$1", "$D$1-12" 'A1 hücresi değişince D1 hücresine 12 ekleyecek ya da ilave edecek
        .Add "$A$2", "$D$2-13"
        .Add "$B$5", "$F$8-14"
        If .Exists(Target.Address) Then
            If Target = "" Then İslem = -1 Else İslem = 1
            Range(Split(.Item(Target.Address), "-")(0)) = Range(Split(.Item(Target.Address), "-")(0)) + İslem * Split(.Item(Target.Address), "-")(1)
        End If
    End With
End Sub

HOCAM COK TEŞEKKÜR EDERİM elinize sağlık

 

[attrd]

.Add ile başlayan satırlarda
$A$1 olan ilk kısım Kaynak yani elle veri girdiğiniz yerler
$D$1 olan ikinci kısmın ilk parçası toplanacak ya da çıkarılacak hücreler
12 olan ikinci kısmın ikinci parçası ekleyecek ya da çıkaracağınız sayılar
Aradaki tire(-) işaretine dokunmayın. Tire öncesine ve sonrasına boşluk bırakmayın.
Arzu ederseniz ilave .Add yazarak yeni hücreler ekleyebilirsiniz. Ben sadece örnek 3 tane ekledim.

Private Sub Worksheet_Change(ByVal Target As Range)
    With CreateObject("Scripting.Dictionary")
        .Add "$A$1", "$D$1-12" 'A1 hücresi değişince D1 hücresine 12 ekleyecek ya da ilave edecek
        .Add "$A$2", "$D$2-13"
        .Add "$B$5", "$F$8-14"
        If .Exists(Target.Address) Then
            If Target = "" Then İslem = -1 Else İslem = 1
            Range(Split(.Item(Target.Address), "-")(0)) = Range(Split(.Item(Target.Address), "-")(0)) + İslem * Split(.Item(Target.Address), "-")(1)
        End If
    End With
End Sub

HOCAM biliyorum cok oldum kusuruma bakmayın A1 hücresi degişince değilde A1 hücresinde deger varsa D1 e ekleme yapması lazım en son yaptıgımızda A1 hücresi değiştikçe D1 sürekli üstüne ekliyor değer değişince değilde hücre dolu ise eklesin boşşa cıkarsın her değiştiğinde eklemesin

 

[ÖmerFaruk]

Zaten o şekilde çalışıyor.
Ben deneyerek yolladım.

 

[attrd]

Zaten o şekilde çalışıyor.
Ben deneyerek yolladım.

Hocam demek istediğim A1 diyelimki 5 yazdım D1 e ekleme yaptı sonra ben A1 deki degeei 8 yaptım yine D1 ekleme yapıyor zaten A1 Dolu oldugu için ikinci eklemede D1 ekleme yapmamalı A1 boşken değer yazarsam eklemeli A1 dolu ise ekleme yapmamalı

 

[ÖmerFaruk]

#4 nolu mesajdaki cevabım üzerine
#5 nolu mesajınızda adresleri değiştirmek istediğinizi söylediniz. Bu da kodların ilk verdiğiniz adrese göre doğru çalıştığı anlamına geliyordu.
Madem öyle aşağıdaki gibi kullanabilirsiniz.
Denemeden düzeltip gönderiyorum. Umarım hata yoktur.

Private Sub Worksheet_Change(ByVal Target As Range)
    With CreateObject("Scripting.Dictionary")
        .Add "$A$1", "$D$1-12" 'A1 hücresi değişince D1 hücresine 12 ekleyecek ya da ilave edecek
        .Add "$A$2", "$D$2-13"
        .Add "$B$5", "$F$8-14"
        If .Exists(Target.Address) Then
        Application.EnableEvents = False
            If Target = "" Then
                Range (Split(.Item(Target.Address), "-")(0))=0
            Else
                Range(Split(.Item(Target.Address), "-")(0)) =  Split(.Item(Target.Address), "-")(1)
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub

 

[attrd]

#4 nolu mesajdaki cevabım üzerine
#5 nolu mesajınızda adresleri değiştirmek istediğinizi söylediniz. Bu da kodların ilk verdiğiniz adrese göre doğru çalıştığı anlamına geliyordu.
Madem öyle aşağıdaki gibi kullanabilirsiniz.
Denemeden düzeltip gönderiyorum. Umarım hata yoktur.

Private Sub Worksheet_Change(ByVal Target As Range)
    With CreateObject("Scripting.Dictionary")
        .Add "$A$1", "$D$1-12" 'A1 hücresi değişince D1 hücresine 12 ekleyecek ya da ilave edecek
        .Add "$A$2", "$D$2-13"
        .Add "$B$5", "$F$8-14"
        If .Exists(Target.Address) Then
        Application.EnableEvents = False
            If Target = "" Then
                Range (Split(.Item(Target.Address), "-")(0))=0
            Else
                Range(Split(.Item(Target.Address), "-")(0)) =  Split(.Item(Target.Address), "-")(1)
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub

HOCAM burdaki problem de D1 de ki sayının üzerine ekleme yapmıyor D1 direk 12 yapıyor diyelimki D1 de3 sayısı var . D1 i 15 yapması gerekirken 3 ü silip 12 yapıyor cıkarırkende D1 deki sayıdan cıkarmıyor direk D1 İ SIFIR yapıyor d1 deki sayıdan cıkarması gerekiyor

 

[attrd]

#4 nolu mesajdaki cevabım üzerine
#5 nolu mesajınızda adresleri değiştirmek istediğinizi söylediniz. Bu da kodların ilk verdiğiniz adrese göre doğru çalıştığı anlamına geliyordu.
Madem öyle aşağıdaki gibi kullanabilirsiniz.
Denemeden düzeltip gönderiyorum. Umarım hata yoktur.

Private Sub Worksheet_Change(ByVal Target As Range)
    With CreateObject("Scripting.Dictionary")
        .Add "$A$1", "$D$1-12" 'A1 hücresi değişince D1 hücresine 12 ekleyecek ya da ilave edecek
        .Add "$A$2", "$D$2-13"
        .Add "$B$5", "$F$8-14"
        If .Exists(Target.Address) Then
        Application.EnableEvents = False
            If Target = "" Then
                Range (Split(.Item(Target.Address), "-")(0))=0
            Else
                Range(Split(.Item(Target.Address), "-")(0)) =  Split(.Item(Target.Address), "-")(1)
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub

HOCAM burdaki problem de D1 de ki sayının üzerine ekleme yapmıyor D1 direk 12 yapıyor diyelimki D1 de3 sayısı var . D1 i 15 yapması gerekirken 3 ü silip 12 yapıyor cıkarırkende D1 deki sayıdan cıkarmıyor direk D1 İ SIFIR yapıyor d1 deki sayıdan cıkarması gerekiyor

 

[ÖmerFaruk]

Sorunuzu her adımda bir öteye taşıyorsunuz.
Ya da bir başka deyişle en başta sorunuzu eksik tanımlıyorsunuz.
Ben pes ettim. Bir başka arkadaş yardımcı olacaktır.