A SÜtunu HÜcresİne Yazilana KarŞilik DeĞer

[cebelitarık]

Bütün forum üyelerine iyi günler

Arkadaşlar yapmak istediğim E sütunu hücreleri veri doğrulama listesinden değer alıyor E sütunu hücresine listeden aldığım değere göre sağındaki hücreye istediğim kelimeyi onun sağındaki hücreyede istediğim kodu otomatik olarak VBA ile yazsın istiyorum
ayrıca sayfanın yüzünde private sub olarak çalışan ve sıra numarası veren bir makrom daha var onunla entegre çalışması lazım
Makrolar çalışıyor fakat sayfa sayısını yazınca makro taa sayfa başından itibaren hesap yapıyor oda uzun sürüyor ayrıca sayfa sayısını silersem defter tipleride silinmesi gerekiyor.
örnek dosya ekte
Yardımcı olursanız müteşekkir kalırım.

 

[Korhan Ayhan]

Selamlar,

Sayfaya ait tüm kodu silip aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [D2:D65536,E2:E65536]) Is Nothing Then Exit Sub
    If Target.Column = 4 Then
    [A2:A65536].ClearContents
    If Target = "" Then
    If [D2] <> "" Then [A2] = 1
    If [D2] <> "" And [D3] <> "" Then [A2] = 1: [A3] = 2
    If [D3] <> "" Then [A2] = 1: [A3] = 2: [A2:A3].AutoFill Destination:=Range("A2:A" & Target.Row - 1)
    Application.EnableEvents = False
    Range("E" & Target.Row & ":F" & Target.Row, "H" & Target.Row).ClearContents
    Application.EnableEvents = True
    Exit Sub: End If
    If [D2] <> "" Then [A2] = 1
    If [D2] <> "" And [D3] <> "" Then [A2] = 1: [A3] = 2
    If [D3] <> "" Then [A2] = 1: [A3] = 2: [A2:A3].AutoFill Destination:=Range("A2:A" & Target.Row)
    End If
    If Target.Column = 5 Then
    If Target = "&#304;&#350;LETME" Then Target.Offset(0, 1) = "&#304;&#350;LETME DEFTER&#304;": Target.Offset(0, 3) = 1
    If Target = "&#350;&#304;RKET KEB&#304;R" Then Target.Offset(0, 1) = "KEB&#304;R DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "GER&#199;EK K&#304;&#350;&#304; KEB&#304;R" Then Target.Offset(0, 1) = "KEB&#304;R DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "&#350;&#304;RKET YEVM&#304;YE" Then Target.Offset(0, 1) = "YEVM&#304;YE DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "GER&#199;EK K&#304;&#350;&#304; YEVM&#304;YE" Then Target.Offset(0, 1) = "YEVM&#304;YE DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "&#350;&#304;RKET ENVANTER" Then Target.Offset(0, 1) = "ENVANTER DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "GER&#199;EK K&#304;&#350;&#304; ENVANTER" Then Target.Offset(0, 1) = "ENVANTER DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "KOOP.KEB&#304;R" Then Target.Offset(0, 1) = "KEB&#304;R DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "KOOP.YEVM&#304;YE" Then Target.Offset(0, 1) = "YEVM&#304;YE DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "KOOP.ENVANTER" Then Target.Offset(0, 1) = "ENVANTER DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "&#350;&#304;RKET Y&#214;N.KUR.KARAR" Then Target.Offset(0, 1) = "Y&#214;NET&#304;M KURULU KARAR DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "&#350;&#304;RKET GEN.KUR.KARAR" Then Target.Offset(0, 1) = "GENEL KURUL KARAR DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "&#350;&#304;RKET DAMGA VERG&#304;S&#304;" Then Target.Offset(0, 1) = "DAMGA VERG&#304;S&#304; DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "&#350;&#304;RKET SERMAYE" Then Target.Offset(0, 1) = "SERMAYE DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "&#350;&#304;RKET ORTAKLAR PAY" Then Target.Offset(0, 1) = "ORTAKLAR PAY DEFTER&#304;": Target.Offset(0, 3) = 5
    If Target = "KOOP.Y&#214;N.KUR.KARAR" Then Target.Offset(0, 1) = "Y&#214;NET&#304;M KURULU KARAR DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "KOOP.GEN.KUR.KARAR" Then Target.Offset(0, 1) = "GENEL KURUL KARAR DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "KOOP.DAMGA VERG&#304;S&#304;" Then Target.Offset(0, 1) = "DAMGA VERG&#304;S&#304; DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "KOOP.SERMAYE" Then Target.Offset(0, 1) = "SERMAYE DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "KOOP.&#220;YE KAYIT" Then Target.Offset(0, 1) = "&#220;YE KAYIT DEFTER&#304;": Target.Offset(0, 3) = 6
    If Target = "SERBEST MESLEK" Then Target.Offset(0, 1) = "SERBEST MESLEK DEFTER&#304;": Target.Offset(0, 3) = 7
    If Target = "&#304;&#350;LETME" Then Target.Offset(0, 1) = "&#304;&#350;LETME DEFTER&#304;": Target.Offset(0, 3) = 1
    If Target = "KOOP.REJ&#304;STRO" Then Target.Offset(0, 1) = "REJ&#304;STRO DEFTER&#304;": Target.Offset(0, 3) = 6
    End If
End Sub

 

[cebelitarık]

Sayın Cost_Control gecenin bu vakti ilgine çok teşekkür ederim
Verdiğiniz kodlar çok güzel ve hızlı çalışıyor.

ancak sizden cevap beklerken d sütunundan sonra bir sütun eklemem gerekmişti ekledikten sonra sizin kodları tekrar uyarlayamadım.

Hangi kodu tekrar değiştirmem gerekiyor.

 

[cebelitarık]

Sayın Cost_Control
Dosyayı yeni duruma göre ayarladım.

Ancak başka hata d sütunundan en alttan itibaren 5 veya 6 hücre birden seçerek silersem hata veriyor.
tek tek silirsem bir şey olmuyor. sebebi ne olabilir.
yardımlarınız için teşekkürler

 

[cebelitarık]

Sayın Cost_Control
Son problemide çözdüm
teşekkürler görüşmek üzere