Seçime göre işlem yaptırmak

A

Alperen25

Katılım
28 Mayıs 2017
Mesajlar
42
Excel Vers. ve Dili
Excel 2016 - TR
Altın Üyelik Bitiş Tarihi
28.05.2022
Arkadaşlar merhaba, bir problemim var ama bölüm bölüm ilerleyerek çözmek istiyorum. Hem bu şekilde daha kolay anlatabileceğimi düşünüyorum. İlk olarak yapmak istediğim şey çoktan seçmeli olan ve seçilen ürüne göre hesaplama yapan bir tablo olması. Bunu biraz araştırdım ama istediğim şeyi bulamadım. Genelde sayfayı koru ile yapılmasını tavsiye etmişler ama benim tablomda korunacak hücreler seçilen ürüne göre değişiyor. Yani mesela ben ilk ürün olarak A ürününü seçmişsem A,B,H aktif, diğerleri pasif, C ürününü seçmişsem A,B,r aktif diğerleri pasif olmalı gibi. Örnek dosya ekte mevcuttur. Yardımlarınızı rica ediyorum.
 

Ekli dosyalar

Ç

çıtır

Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
Kare ve Daier'yi anladımda ürünlerin hesaplama yöntemi nasıl belirleniyor? Kaç çeşit ürün olaçak anlayamadım.Örneklendirerek açıklarsanız çözüme katkı olur.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B4:B100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then
    Target.Offset(0, 8) = ""
    Exit Sub
End If
a = Target.Row
If Target = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    Cells(a, "C").Select
ElseIf Target = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    Cells(a, "I").Select
ElseIf Target = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    Cells(a, "C").Select
ElseIf Target = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    Cells(a, "C").Select
ElseIf Target = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    Cells(a, "C").Select
Else
    Cells(a, "J") = "Tanımsız Ürün"
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C4:I100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Cells(a, "B") = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    If Target.Column > 4 Then
        Cells(a, "D").Select
    End If
ElseIf Cells(a, "B") = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    If Target.Column < 9 Then
        Cells(a, "I").Select
    End If
ElseIf Cells(a, "B") = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    If Target.Column > 7 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    If Target.Column > 4 And Target.Column < 9 Then
        Cells(a, "I").Select
    End If
End If
End Sub
 
A

Alperen25

Katılım
28 Mayıs 2017
Mesajlar
42
Excel Vers. ve Dili
Excel 2016 - TR
Altın Üyelik Bitiş Tarihi
28.05.2022
Tabloda örnek olması için ürünleri öyle rastgele yazdım. 15-20 çeşit ürün var ve bunların metrekaresi alınıyor. Nasıl alındıklarına dair formüller vs var. Onlar hazır şuan. Ama mesela aktif olduğum hücreye kare yazınca karenin alanını hesaplama için gerekli parametreler aktif olsun diğer parametreler pasif olsun ve hesaplama kısmında da kareye ait formül çalışsın.

if aktif olduğum hücrede seçtiğim ürün = A ürünü Then
Hücre a,b,h aktif,
Hücre c,d,s,r pasif,
Hesaplama hücresinde A ürününe ait formülü çalıştır.

else if aktif olduğum hücrede seçtiğim ürün = B ürünü Then
Hücre a,b,c,d,h aktif,
Hücre s,r pasif
Hesaplama hücresinde B ürününe ait formülü çalıştır.

...

gibi.


çıtır' Alıntı:
Kare ve Daier'yi anladımda ürünlerin hesaplama yöntemi nasıl belirleniyor? Kaç çeşit ürün olaçak anlayamadım.Örneklendirerek açıklarsanız çözüme katkı olur.
Genişletmek için tıkla ...
 
A

Alperen25

Katılım
28 Mayıs 2017
Mesajlar
42
Excel Vers. ve Dili
Excel 2016 - TR
Altın Üyelik Bitiş Tarihi
28.05.2022
Yusuf bey desteğiniz için teşekkür ederim. Fakat seçmiş olduğum hücredeki ürünü değiştirince eski seçime ait değerler kalıyor ve silinmiyorlar da. Yani Daire seçimini Kare olarak değiştirince en sonradaki r değerini silemiyorum öylece kalıyor.

YUSUF44' Alıntı:
Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B4:B100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then
    Target.Offset(0, 8) = ""
    Exit Sub
End If
a = Target.Row
If Target = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    Cells(a, "C").Select
ElseIf Target = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    Cells(a, "I").Select
ElseIf Target = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    Cells(a, "C").Select
ElseIf Target = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    Cells(a, "C").Select
ElseIf Target = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    Cells(a, "C").Select
Else
    Cells(a, "J") = "Tanımsız Ürün"
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C4:I100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Cells(a, "B") = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    If Target.Column > 4 Then
        Cells(a, "D").Select
    End If
ElseIf Cells(a, "B") = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    If Target.Column < 9 Then
        Cells(a, "I").Select
    End If
ElseIf Cells(a, "B") = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    If Target.Column > 7 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    If Target.Column > 4 And Target.Column < 9 Then
        Cells(a, "I").Select
    End If
End If
End Sub
Genişletmek için tıkla ...
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Örnek dosyanızda yer alan verilere göre aşağıdaki gibi deneyin. Ancak farklı ürünler varsa (ki öyle olduğunu söylüyorsunuz, her ürün için özel durumların aynı bu kodlarda olduğu gibi açık bir şekilde belirtilmesi gerekir:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B4:B100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Target = "" Then
    Range("C" & a & ":J" & a).ClearContents
    Exit Sub
End If
Range("C" & a & ":J" & a).ClearContents
If Target = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    Cells(a, "C").Select
ElseIf Target = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    Cells(a, "I").Select
ElseIf Target = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    Cells(a, "C").Select
ElseIf Target = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    Cells(a, "C").Select
ElseIf Target = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    Cells(a, "C").Select
Else
    Cells(a, "J") = "Tanımsız Ürün"
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C4:I100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Cells(a, "B") = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    If Target.Column > 4 Then
        Cells(a, "D").Select
    End If
ElseIf Cells(a, "B") = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    If Target.Column < 9 Then
        Cells(a, "I").Select
    End If
ElseIf Cells(a, "B") = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    If Target.Column > 7 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    If Target.Column > 4 And Target.Column < 9 Then
        Cells(a, "I").Select
    End If
End If
End Sub
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kod aşağıdaki haliyle daha iyi oldu bence:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B4:B100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Target = "" Then
    Range("C" & a & ":J" & a).ClearContents
    Range("C" & a & ":J" & a).Interior.Color = xlNone
    Exit Sub
End If
Range("C" & a & ":J" & a).ClearContents
Range("C" & a & ":J" & a).Interior.Color = xlNone

If Target = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    Range("E" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("E" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
ElseIf Target = "DAİRE" Then
    Range("C" & a & ":H" & a).Interior.ThemeColor = xlThemeColorDark1
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    Cells(a, "I").Select
ElseIf Target = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("H" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("E" & a & ":F" & a).Interior.TintAndShade = -0.249977111117893
    Range("H" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
ElseIf Target = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    Range("H" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("H" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
ElseIf Target = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    Range("E" & a & ":H" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("E" & a & ":H" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
Else
    Cells(a, "J") = "Tanımsız Ürün"
    Range("C" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("C" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Target.Select
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C4:I100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Cells(a, "B") = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    If Target.Column > 4 Then
        Cells(a, "D").Select
    End If
ElseIf Cells(a, "B") = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    If Target.Column < 9 Then
        Cells(a, "I").Select
    End If
ElseIf Cells(a, "B") = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    If Target.Column > 7 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    If Target.Column > 4 And Target.Column < 9 Then
        Cells(a, "I").Select
    End If
End If
End Sub
 
A

Alperen25

Katılım
28 Mayıs 2017
Mesajlar
42
Excel Vers. ve Dili
Excel 2016 - TR
Altın Üyelik Bitiş Tarihi
28.05.2022
Teşekkür ederim Yusuf bey, ürünler tablomu belirttiğiniz üzere test için hazır hale getirdim. Dosyayı ekledim. Göndermiş olduğunuz kodu denedim ama bazılarında renklendirme yapıyor bazılarında yapmıyor. Bir de hücre pasif olunca ilerletmiyor. Yani sadece giriş yapılmasına müsaade etmese fakat sağa sola hareket etmemize izin verse daha kullanışlı olacak gibi. Bu şekilde biraz zorluyor gibi geldi.

YUSUF44' Alıntı:
Kod aşağıdaki haliyle daha iyi oldu bence:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B4:B100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Target = "" Then
    Range("C" & a & ":J" & a).ClearContents
    Range("C" & a & ":J" & a).Interior.Color = xlNone
    Exit Sub
End If
Range("C" & a & ":J" & a).ClearContents
Range("C" & a & ":J" & a).Interior.Color = xlNone

If Target = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    Range("E" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("E" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
ElseIf Target = "DAİRE" Then
    Range("C" & a & ":H" & a).Interior.ThemeColor = xlThemeColorDark1
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    Cells(a, "I").Select
ElseIf Target = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("H" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("E" & a & ":F" & a).Interior.TintAndShade = -0.249977111117893
    Range("H" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
ElseIf Target = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    Range("H" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("H" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
ElseIf Target = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    Range("E" & a & ":H" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("E" & a & ":H" & a).Interior.TintAndShade = -0.249977111117893
    Cells(a, "C").Select
Else
    Cells(a, "J") = "Tanımsız Ürün"
    Range("C" & a & ":I" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("C" & a & ":I" & a).Interior.TintAndShade = -0.249977111117893
    Target.Select
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C4:I100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Cells(a, "B") = "KARE" Then
    Cells(a, "J").FormulaR1C1 = "=RC[-7]*RC[-6]"
    If Target.Column > 4 Then
        Cells(a, "D").Select
    End If
ElseIf Cells(a, "B") = "DAİRE" Then
    Cells(a, "J").FormulaR1C1 = "=3.14*RC[-1]*RC[-1]"
    If Target.Column < 9 Then
        Cells(a, "I").Select
    End If
ElseIf Cells(a, "B") = "Ürün A" Then
    Cells(a, "J").FormulaR1C1 = "=2*(RC[-7]+RC[-6])*RC[-3]"
    If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün B" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6]+RC[-5]+RC[-4])*RC[-3]/100"
    If Target.Column > 7 Then
        Cells(a, "G").Select
    End If
ElseIf Cells(a, "B") = "Ürün C" Then
    Cells(a, "J").FormulaR1C1 = "=(RC[-7]+RC[-6])/RC[-1]"
    If Target.Column > 4 And Target.Column < 9 Then
        Cells(a, "I").Select
    End If
End If
End Sub
Genişletmek için tıkla ...
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Örnek dosyanızla bu dosyanız pek uyuşmuyor, önceki kodları bu dosyaya uydurmak için epey uğraştım. Lütfen soruyla uyumlu örnek dosya paylaşmaya özen gösterelim. Eski kodlar yerine aşağıdaki kodları deneyiniz:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A100]) Is Nothing Then GoTo 10
If Selection.Count > 1 Then Exit Sub
a = Target.Row
Application.EnableEvents = False

If Target = "" Then
    Range("B" & a & ":J" & a).ClearContents
    Range("B" & a & ":J" & a).Interior.Color = xlNone
    Exit Sub
End If
Range("B" & a & ":J" & a).ClearContents
Range("B" & a & ":J" & a).Interior.Color = xlNone
Range("A" & a & ":Q" & a).Borders.LineStyle = 1
Range("L" & a & ":N" & a).Interior.ThemeColor = xlThemeColorDark1
Range("L" & a & ":N" & a).Interior.TintAndShade = -0.249977111117893
Range("P" & a & ":Q" & a).Interior.ThemeColor = xlThemeColorDark1
Range("P" & a & ":Q" & a).Interior.TintAndShade = -0.249977111117893

If Target = "KNL" Then
    Cells(a, "L").FormulaR1C1 = "=IF(RC[-1]>=1,((((RC[-9]+RC[-8])*2)*RC[-5])*RC[-1])/10000,IF(RC[-1]<=0,""ÖLÇÜ GİRİNİZ""))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":F" & a).Interior.TintAndShade = 0.799981688894314
    Range("H" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("H" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "KPK" Then
    Cells(a, "L").FormulaR1C1 = "=((RC[-9]+6)*(RC[-8]+6)*RC[-1])/10000"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "DRS" Then
    Cells(a, "L").FormulaR1C1 = "=IF(RC[-1]>=1,2*3.14*(RC[-2]/360)*(RC[-9]+2*RC[-3])/100*(RC[-9]+RC[-8])/100*RC[-1],IF(RC[-1]<=0,""ÖLÇÜ GİRİNİZ""))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":H" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":H" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "RED" Then
    Cells(a, "L").FormulaR1C1 = "=IF((RC[-1]>=1),(((RC[-9]+RC[-7])/100)*SQRT((RC[-5]/100)^2+(RC[-6]/200-RC[-8]/200)^2)+(RC[-8]/100+RC[-6]/100)*SQRT((RC[-5]/100)^2+(RC[-9]/200-RC[-7]/200)^2))*RC[-1],IF(RC[-1]<=0,""ÖLÇÜ GİRİNİZ""))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("H" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("H" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "ADA" Then
    Cells(a, "L").FormulaR1C1 = "=(((((RC[-10]*3.14)+((RC[-9]+RC[-8])*2))/2)*RC[-5])/10000)*RC[-1]"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":F" & a).Interior.TintAndShade = 0.799981688894314
    Range("H" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("H" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "B").Select
ElseIf Target = "ESP" Then
    Cells(a, "L").FormulaR1C1 = "=IF(RC[-4]<=0,""ÖLÇÜ GİRİNİZ"",IF(RC[-1]>=1,((RC[-9]+RC[-8])/100)*2*SQRT(RC[-5]^2+RC[-4]^2)/100*RC[-1],IF(R[-4]C[197]<=0,""ADET GİRİNİZ"")))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":F" & a).Interior.TintAndShade = 0.799981688894314
    Range("I" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("I" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
Else
    Cells(a, "B") = "Tanımsız Ürün"
    Range("B" & a & ":Q" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("B" & a & ":Q" & a).Interior.TintAndShade = -0.249977111117893
    Target.Select
End If
    Application.EnableEvents = True
10:
If Intersect(Target, [B2:Q100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Interior.Color <> xlNone Then
    MsgBox "Bu hücreyi değiştiremezsiniz!", vbInformation
        Target = ""
    Cells(Target.Row, "A") = ""
    Application.EnableEvents = True
    Exit Sub
End If
    Application.EnableEvents = True
End Sub
 
A

Alperen25

Katılım
28 Mayıs 2017
Mesajlar
42
Excel Vers. ve Dili
Excel 2016 - TR
Altın Üyelik Bitiş Tarihi
28.05.2022
Haklısınız özür dilerim daha dikkatli olmalıydım. Kurusa bakmayın.
Yeni kodu denemek istedim ama ne işlem yapsam mesaj veriyor ve o hücredeki değeri siliyor. Herhangi bir işlem yaptırmıyor.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kodları aşağıdaki gibi deneyin ancak veri girilemeyecek hücrelerdeki işlemi iptal ettim, çünkü isteğinizi nasıl yapacağımı bilemedim, yaptığım şekli zaten gördüğünüz hataya sebep olmuştu:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row

If Target = "" Then
    Range("B" & a & ":J" & a).ClearContents
    Range("B" & a & ":J" & a).Interior.Color = xlNone
    Exit Sub
End If
Range("B" & a & ":J" & a).ClearContents
Range("B" & a & ":J" & a).Interior.Color = xlNone
Range("A" & a & ":Q" & a).Borders.LineStyle = 1
Range("L" & a & ":N" & a).Interior.ThemeColor = xlThemeColorDark1
Range("L" & a & ":N" & a).Interior.TintAndShade = -0.249977111117893
Cells(a, "P").Interior.ThemeColor = xlThemeColorDark1
Cells(a, "P").Interior.TintAndShade = -0.249977111117893
Cells(a, "L").NumberFormat = "0.000"
Cells(a, "M").NumberFormat = "0.00"
Cells(a, "N").NumberFormat = "0.00"
Cells(a, "M").NumberFormat = "0.0"
Cells(a, "P").NumberFormat = "_-$* #,##0.00_-;-$* #,##0.00_-;_-$* ""-""??_-;_-@_-"
Cells(a, "Q").NumberFormat = "_-$* #,##0.00_-;-$* #,##0.00_-;_-$* ""-""??_-;_-@_-"

If Target = "KNL" Then
    Cells(a, "L").FormulaR1C1 = "=IF(RC[-1]>=1,((((RC[-9]+RC[-8])*2)*RC[-5])*RC[-1])/10000,IF(RC[-1]<=0,""ÖLÇÜ GİRİNİZ""))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":F" & a).Interior.TintAndShade = 0.799981688894314
    Range("H" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("H" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "KPK" Then
    Cells(a, "L").FormulaR1C1 = "=((RC[-9]+6)*(RC[-8]+6)*RC[-1])/10000"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "DRS" Then
    Cells(a, "L").FormulaR1C1 = "=IF(RC[-1]>=1,2*3.14*(RC[-2]/360)*(RC[-9]+2*RC[-3])/100*(RC[-9]+RC[-8])/100*RC[-1],IF(RC[-1]<=0,""ÖLÇÜ GİRİNİZ""))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":H" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":H" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "RED" Then
    Cells(a, "L").FormulaR1C1 = "=IF((RC[-1]>=1),(((RC[-9]+RC[-7])/100)*SQRT((RC[-5]/100)^2+(RC[-6]/200-RC[-8]/200)^2)+(RC[-8]/100+RC[-6]/100)*SQRT((RC[-5]/100)^2+(RC[-9]/200-RC[-7]/200)^2))*RC[-1],IF(RC[-1]<=0,""ÖLÇÜ GİRİNİZ""))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("H" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("H" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
ElseIf Target = "ADA" Then
    Cells(a, "L").FormulaR1C1 = "=(((((RC[-10]*3.14)+((RC[-9]+RC[-8])*2))/2)*RC[-5])/10000)*RC[-1]"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":F" & a).Interior.TintAndShade = 0.799981688894314
    Range("H" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("H" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "B").Select
ElseIf Target = "ESP" Then
    Cells(a, "L").FormulaR1C1 = "=IF(RC[-4]<=0,""ÖLÇÜ GİRİNİZ"",IF(RC[-1]>=1,((RC[-9]+RC[-8])/100)*2*SQRT(RC[-5]^2+RC[-4]^2)/100*RC[-1],IF(R[-4]C[197]<=0,""ADET GİRİNİZ"")))"
    Cells(a, "M").FormulaR1C1 = "=IF(RC[-1]<>"""",IF(RC[-1]<1,1,RC[-1]),"""")"
    Cells(a, "N").FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "Q").FormulaR1C1 = "=IF(RC[-3]<>"""",RC[-1]*RC[-3],"""")"
    Cells(a, "B").Interior.ThemeColor = xlThemeColorAccent6
    Cells(a, "B").Interior.TintAndShade = 0.799981688894314
    Range("E" & a & ":F" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("E" & a & ":F" & a).Interior.TintAndShade = 0.799981688894314
    Range("I" & a & ":J" & a).Interior.ThemeColor = xlThemeColorAccent6
    Range("I" & a & ":J" & a).Interior.TintAndShade = 0.799981688894314
    Cells(a, "C").Select
Else
    Cells(a, "B") = "Tanımsız Ürün"
    Range("B" & a & ":Q" & a).Interior.ThemeColor = xlThemeColorDark1
    Range("B" & a & ":Q" & a).Interior.TintAndShade = -0.249977111117893
    Target.Select
End If

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst