Sarta göre makro

**#1)** **attrd112** » 21 May 2023 01:12

İyi günler
A1 hücresi dolu ise D1 hücresindeki sayıya 12 ekle boşalırsa ekledigin sayıyı cıkar
B1 hücresi dolu ise E1 hücresindeki sayıya 15 ekle tekrar boşalırsa eklediğin sayıyı cıkar
...
Seklinde hücre dolu ise eklesin , tekrar boş olursa eklediğini cıkarsın
Makro ile yapılabilir mi
Simdiden teşekkür ederim

**#2)** **okutkan** » 22 May 2023 14:38

A1 hücresine değer yazıldığında D1 hücresindeki değere A1 hücresi değeri kadar eklenir.
A1 hücresindeki değer silinip hücre boş kalırsa, A1 hücresindeki silinmeden önceki değer D1 hücresinden çıkarılır.
Bunun için önceki değerleri çıkarma işleminde kullanmak için yardımcı hücre gerekir.
Aşağıdaki kodu kullanıp, a1 ve b1 hücrelerine değer girin; bir kaç değer değiştirip toplama işlemini gözlemleyin.
Daha sonra a1 hücresini seçip delete tuşu ile hücredeki değeri silin. Sildiğiniz değer kadar D1 hücresinden çıkarılacaktır.

Sayfanın kod bölümüne yazın.

Kod: Tümünü seç: Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [a1:b1]) Is Nothing Or Selection.Count > 1 Then Exit Sub sayi = Target.Offset(0, 5) If Target <> "" And IsNumeric(Target) Then Target.Offset(0, 2).Value = Target.Value + Target.Offset(0, 2).Value Else Target.Offset(0, 2).Value = Target.Offset(0, 2).Value - sayi End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, [a1:b1]) Is Nothing Or Selection.Count > 1 Then Exit Sub Target.Offset(0, 5) = Target.Value End Sub

**#3)** **attrd112** » 23 May 2023 10:17

hocam öncelikle elinize sağlık ilginiz için teşekür ederim . D1 hücresine eklenecek değer a1 deki değilde sabit bir sayı diyelimki 10 ve bu 10 ben kod içinden değiştirebileyim ayrıca bu kombinasyonu A1 e D1, B2 e G3 ,C4 E H6 gibi farklı hücrelerde cogaltabilmem gerekiyor Ayrıca A1 sayı değil başka karakterde olsa HARF DE OLSA yani A1 dolu ise eklesin A1 i silincede cıkArması gerekiyor

**#4)** **okutkan** » 23 May 2023 10:20

Gün içinde yardımcı olmaya çalışırım.

**#5)** **okutkan** » 23 May 2023 10:23

A1 e D1, B2 e G3 ,C4 E H6

Bunların her biri için kod içerisine çıkarılacak sayı değeri girilecek mi yoksa kod içinden tek bir sayıyı mı değiştireceksiniz?

**#6)** **attrd112** » 23 May 2023 10:39

hocam sayı değeri de değişecek hücreleride sayı değerlerinide kod içinden değişebilmem lazım

ördegin A1 e D1, sayı 10
B2 e G3 , sayı 15
C4 E H6 sayı 18
olsun ben bunları kod sayfasından değişebileyim ve bu kombinasyonuda cogaltabileyim

**#7)** **okutkan** » 23 May 2023 11:15

Maksimum kaç adet satır kullanacaksın?

**#8)** **okutkan** » 23 May 2023 11:18

Birde verdiğiniz örnekte aynı sütun bulunmuyor, çok dağınık bir şekilde hücre isimleri yazmışsınız. Neye göre hangi hücreden eksilecek hangi hücreye yazılacak bir düzen olması lazım. Örnek dosya da yükleseniz iyi olur.

**#9)** **attrd112** » 23 May 2023 13:14

okutkan yazdı:Birde verdiğiniz örnekte aynı sütun bulunmuyor, çok dağınık bir şekilde hücre isimleri yazmışsınız. Neye göre hangi hücreden eksilecek hangi hücreye yazılacak bir düzen olması lazım. Örnek dosya da yükleseniz iyi olur.

HOCAM OZAMAN SÖYLE SABİTLEYEYİM
A1 de sayı veya yazı varsa yani hücre dolu ise D1 e 13 eklesin A1 deki sayı veya yazıyı silince D1 e eklediği 13 ü çıkarsın
B2 de sayı veya yazı varsa yani hücre dolu ise D2 e 15 eklesin B2 deki sayı veya yazıyı silince D2 e eklediği 15 ü çıkarsın
C3 de sayı veya yazı varsa yani hücre dolu ise D2 e 16 eklesin C3 deki sayı veya yazıyı silince D3 e eklediği 16 ü çıkarsın

**#10)** **okutkan** » 23 May 2023 13:57

Sayfa kod alanına yapıştırın.

Kod: Tümünü seç: Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + 13 Else [D1].Value = [D1].Value - 13 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + 15 Else [D2].Value = [D1].Value - 15 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + 16 Else [D3].Value = [D3].Value - 16 End If End If End Sub

**#11)** **okutkan** » 23 May 2023 13:59

Aşağıdaki şekilde kullanırsanız sayıları değiştirmek daha basit olacaktır.

Kod: Tümünü seç: Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) A1 = 13 B2 = 15 C3 = 16 If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + A1 Else [D1].Value = [D1].Value - A1 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + B2 Else [D2].Value = [D1].Value - B2 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + C3 Else [D3].Value = [D3].Value - C3 End If End If End Sub

**#12)** **attrd112** » 23 May 2023 14:40

okutkan yazdı:Aşağıdaki şekilde kullanırsanız sayıları değiştirmek daha basit olacaktır.

Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) A1 = 13 B2 = 15 C3 = 16 If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + A1 Else [D1].Value = [D1].Value - A1 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + B2 Else [D2].Value = [D1].Value - B2 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + C3 Else [D3].Value = [D3].Value - C3 End If End If End Sub

HOCAM ELİNİZE SAĞLIK burda ki problem A1 dolu iken tekrar A1e sayı yada yazı yazınca D1 e ekleme yapmaması gerekiyor sadece boş iken A1 doldurunca ekleme yapmalı , A1 i silerkende A1 e aklama yapıldı ise silsin ekleme yapılmadı ise silmesin bu sekilde olması gerekiyor

**#13)** **okutkan** » 23 May 2023 17:18

A1 hücresinde 10 yazıyor diyelim.
A1 hücresine 11 yazdığımızda, 11 i yazmadan önce hücrenin son halini(dolu mu boş mu) değerlendirme imkanı var mı bilmiyorum.
Bunun için önceki değeri hafızada tutma bağlamında yardımcı bir sütun kullanılabilir. Son işlem öncesi değeri yardımcı sütunda tutulur, son işlem ile önceki işlem eşit mi kontrol edilir, eğer eşitse herhangi bir çıkarma toplama işlemi yapılmaz gibi..

**#14)** **attrd112** » 23 May 2023 18:38

okutkan yazdı:A1 hücresinde 10 yazıyor diyelim.
A1 hücresine 11 yazdığımızda, 11 i yazmadan önce hücrenin son halini(dolu mu boş mu) değerlendirme imkanı var mı bilmiyorum.
Bunun için önceki değeri hafızada tutma bağlamında yardımcı bir sütun kullanılabilir. Son işlem öncesi değeri yardımcı sütunda tutulur, son işlem ile önceki işlem eşit mi kontrol edilir, eğer eşitse herhangi bir çıkarma toplama işlemi yapılmaz gibi..

peki bu dediğiniz şekilde nasıl uyarlarız hocam ??

**#15)** **okutkan** » 23 May 2023 20:28

Yardımcı sütuna gerek kalmadan aşağıdaki kodu kullanıp deneyin.

Kod: Tümünü seç: Public A1S As Variant Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) A1 = 13 B2 = 15 C3 = 16 If A1S = "" Then If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + A1 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + B2 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + C3 End If End If ElseIf A1S <> "" Then If ad = "A1" Then If Target = "" Then [D1].Value = [D1].Value - A1 End If ElseIf ad = "B2" Then If Target = "" Then [D2].Value = [D2].Value - B2 End If ElseIf ad = "C3" Then If Target = "" Then [D3].Value = [D3].Value - C3 End If End If End If End Sub Public Sub Worksheet_SelectionChange(ByVal Target As Range) A1S = Target.Text End Sub

**#16)** **attrd112** » 23 May 2023 20:56

okutkan yazdı:Yardımcı sütuna gerek kalmadan aşağıdaki kodu kullanıp deneyin.
Kod: Tümünü seç
Public A1S As Variant Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) A1 = 13 B2 = 15 C3 = 16 If A1S = "" Then If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + A1 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + B2 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + C3 End If End If ElseIf A1S <> "" Then If ad = "A1" Then If Target = "" Then [D1].Value = [D1].Value - A1 End If ElseIf ad = "B2" Then If Target = "" Then [D2].Value = [D2].Value - B2 End If ElseIf ad = "C3" Then If Target = "" Then [D3].Value = [D3].Value - C3 End If End If End If End Sub Public Sub Worksheet_SelectionChange(ByVal Target As Range) A1S = Target.Text End Sub

HOCAM ELİNİZE SAĞLIK ÇOK TEŞEKÜR EDERİM OLURSA BU ŞEKİLDE KULLANABİLİRİM YANLIZ OLURSA A1 Deyken silerken 2 - 3 KERE ARD ARDINA DELETE YAPINCA HEP CIKARIYOR . DELETE YAPIP BASKA HÜCREYE TIKLANINCA SIKINTI YOK DELETEYE ART ARDA BASMA OLAYIDA DÜZELİRSE SÜPER OLUR

**#17)** **okutkan** » 23 May 2023 21:02

Yarın tekrar bakalım.Konuya yarın mesaj yazın mail bildirimi gelsin.

**#18)** **okutkan** » 24 May 2023 11:30

Aşağıdaki kodu kullanın.

Kod: Tümünü seç: Public A1S As Variant Public Sub Worksheet_SelectionChange(ByVal Target As Range) A1S = Target.Text End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) A1 = 13 B2 = 15 C3 = 16 Set aaa = Target If A1S = "" Then If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + A1 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + B2 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + C3 End If End If 'And Not Target = Empty ElseIf A1S <> "" Then If ad = "A1" Then If Target = "" Then [D1].Value = [D1].Value - A1 End If ElseIf ad = "B2" Then If Target = "" Then [D2].Value = [D2].Value - B2 End If ElseIf ad = "C3" Then If Target = "" Then [D3].Value = [D3].Value - C3 End If End If Target.Offset(0, 1).Select aaa.Select End If End Sub

**#19)** **attrd112** » 24 May 2023 23:31

Cuma deneyip size dönüş yapacagım hocam

**#20)** **attrd112** » 26 May 2023 10:25

okutkan yazdı:Aşağıdaki kodu kullanın.
Kod: Tümünü seç
Public A1S As Variant Public Sub Worksheet_SelectionChange(ByVal Target As Range) A1S = Target.Text End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1, B2, C3")) Is Nothing Or Selection.Count > 1 Then Exit Sub ad = Target.Address(0, 0) A1 = 13 B2 = 15 C3 = 16 Set aaa = Target If A1S = "" Then If ad = "A1" Then If Target <> "" Then [D1].Value = [D1].Value + A1 End If ElseIf ad = "B2" Then If Target <> "" Then [D2].Value = [D2].Value + B2 End If ElseIf ad = "C3" Then If Target <> "" Then [D3].Value = [D3].Value + C3 End If End If 'And Not Target = Empty ElseIf A1S <> "" Then If ad = "A1" Then If Target = "" Then [D1].Value = [D1].Value - A1 End If ElseIf ad = "B2" Then If Target = "" Then [D2].Value = [D2].Value - B2 End If ElseIf ad = "C3" Then If Target = "" Then [D3].Value = [D3].Value - C3 End If End If Target.Offset(0, 1).Select aaa.Select End If End Sub

HOCAM ELİNİZE SAĞLIK TEŞEKÜR EDERİM GÜZEL OLDU

Sarta göre makro

Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Sarta göre makro

Cevap: Cevap: Sarta göre makro

Online Kullanıcılar

ExcelVBA.Net sitesine katkıda bulunabilirsiniz

Tarkan VURAL

Kapat

Online Kullanıcılar