• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Worksheet_Change if else ile kullanma nasıl ?

uzmanamele' Alıntı:
Ne diyeyim şimdi?!...

Aşağıki mahallede Laz bakkal var, oradan iyi kodlar bulabilirsiniz.
Genişletmek için tıkla ...

Kusura bakmayın yanlış cümle kurdum.
makrodan kasdedilen sub a1 sub a2... yani bu makrolar da sıkıntı yok tam istediğim gibi

kodları çalıştıramamaktan bahsedilen ise kodun çalışmaması ha bende çalıştıramamış olabilirim kesin konuşmamak gerek.

karadeniz değil akdenizliyim. :hihoho:
 
eneskus' Alıntı:
Kodu çoklu makro çalıştıracak şekilde nasıl değiştirebiliriz açaba yani örnek vermek gerekirse u2-u3-u4 verileri değişirse prog_a1 prog_a2 prog_a3 makroları çalışacak tek satırda işlem yapıldığında o satırla ilgili makro çalışacak birden fazla satırda değişiklik yapıldığında değişiklik yapılan satırlarla ilgili tüm makrolar çalışacak şekilde nasıl ayarlaya biliriz acaba.

İlgi ve alakanız için teşekkürler.
Genişletmek için tıkla ...


Aşağıdaki kodları dener misiniz?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
End Sub
 
Necdet Yeşertener' Alıntı:
Aşağıdaki kodları dener misiniz?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
End Sub
Genişletmek için tıkla ...

Allah razı olsun. Çok teşekkür ederim. Çalışıyor.

Kızmaz iseniz ufak bir soru: örneğin u:u için prog_a makrosu çalışacak w:w için prog_b makrosu şeklinde ve .... nasıl bir yol izlemem ve makroda nerelerde değişiklik yapmam gerek acaba. Bu konudada yardımcı olursanız çok teşekkür ederim.
 
Merhaba,

Kolon numarasından yararlanabilirsiniz.

U için :

Kod: 
If Target.Column = 21 Then .....
gibi.
 
Necdet Yeşertener' Alıntı:
Merhaba,

Kolon numarasından yararlanabilirsiniz.

U için :

Kod: 
If Target.Column = 21 Then .....
gibi.
Genişletmek için tıkla ...

Teşekkür ederim ancak aşağıdaki kodu bir incelemeniz mümkünmü.
[U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE] aralığındaki değişikliklerde formül düzgün çalışmakta ancak [AG:AG, AL:AL, AK:AK,AM:AM] aralığında hata vermekte çözüm için yardım ederseniz sevinirim.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, [U:U,W:W,Y:Y,AA:AA, AC:AC, AE:AE]) Is Nothing Or Target.Row < 2 Then
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
    
    Else
         If Not Intersect(Target, [AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then
         
    Dim Progg    As String
    Dim Hcrr     As Range
    
     Target.Select
    
    For Each Hcrr In Selection
        Prog = "Progg_b" & Hcrr.Row - 1
        Application.Run CStr(Progg)
    Next Hcrr
    End If
    End If
End Sub
özür dilerim kodları yanlış bu nedenden düzenlendi
 
Son düzenleme:
Ne meraklısınız aynı kodları defalarca yazmaya?, Sadece target ı belirleseniz yeterli.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE, AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
    
End Sub
 
Necdet Yeşertener' Alıntı:
Ne meraklısınız aynı kodları defalarca yazmaya?, Sadece target ı belirleseniz yeterli.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE, AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
    
End Sub
Genişletmek için tıkla ...
Yapmak istediğimi anlatamadım özür dilerim. sizin sölemiş olduğunuz benimde aklıma geldi. Ancak
[U:U,W:W,Y:Y,AA:AA, AC:AC, AE:AE] değişince prog_a makroları YENİ MAL. MUT. sayfasında değişiklik yapmakta.
[AG:AG, AL:AL, AK:AK,AM:AM] değişince prog_b makroları DEMONTAJ MAL. MUT. sayfasında değişiklik yapmakta.

Bu nedenle ayırmam gerekmekte bilmem anlatabildimmi.
 
olsun yinede aynı kodları yinelememek gerek.

Bu durumda target.column kullanabilirsiniz.

AE sütununa kadar bir program, AE sütunundan sonrakilerde başka program çalışacaksa, AE sütununun numarası 31 dir, buna göre

If Target.Column < 32 then
A Programını Çalıştır
Then
B Programını Çalıştır
End If

gibi bir mantık yürütmeli.
 
Necdet Yeşertener' Alıntı:
olsun yinede aynı kodları yinelememek gerek.

Bu durumda target.column kullanabilirsiniz.

AE sütununa kadar bir program, AE sütunundan sonrakilerde başka program çalışacaksa, AE sütununun numarası 31 dir, buna göre

If Target.Column < 32 then
A Programını Çalıştır
Then
B Programını Çalıştır
End If

gibi bir mantık yürütmeli.
Genişletmek için tıkla ...

benzer bir mantıkla bende

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, [U:U,W:W,Y:Y,AA:AA, AC:AC, AE:AE]) Is Nothing Or Target.Row < 2 Then
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
    
    Else
         If Not Intersect(Target, [AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then
         
    Dim Prog    As String
    Dim Hcrr     As Range
    
     Target.Select
    
    For Each Hcrr In Selection
        Prog = "Prog_b" & Hcrr.Row - 1
        Application.Run CStr(Prog)
    Next Hcrr
    End If
    End If
End Sub

Kodunu yazmaya çalıştım ama hata verdi yapamadım.
 
Merhaba...

eneskus;

Sorununuzla direkt ilgili değil ama ben, veri depolama ve de yönetimi için yanlış program seçtiğiniz düşünüyorum.. Hem bu kadar veriyi saklayacaksınız hem de -neredeyse- her hücreyi kontrol edecekseniz Excel'e acı çektirirsiniz.. Tabi siz de aynı şekilde..

Bir an önce Excel'i terk edip bir veritabanı programı ile çalışmanızı öneririm.. İnanın, bu dosyada karşılaşacağınız sorunları aşmak için harcadığınız zamanı başka bir programı öğrenmekte harcarsanız daha çok yol katedetsiniz..

Mesajımı yanlış yorumlamamanızı isterim.. Benimkisi sadece samimi bir öneri.. ;)

Kolaylıklar...
 
Azda olsa anladığımız excel var diğerlerinin adını bile bilmem. Şimdilik excel e devam
 
Abilerim konu Hala çözülmedi malesef.
 
Son düzenleme:
Soruyu şu şekilde güncellesek:

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_a" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
End Sub

Kodunu ve:

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        Prog = "Prog_b" & Hcr.Row - 1
        Application.Run CStr(Prog)
    Next Hcr
End Sub

Kodlarını nasıl birleştire bilirim.
 
Merhaba,

Bu şekilde deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE,AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        If Hcr.Column < 32 Then
            Prog = "Prog_a" & Hcr.Row - 1
            Application.Run CStr(Prog)
        Else
            Prog = "Prog_b" & Hcr.Row - 1
            Application.Run CStr(Prog)
        End If
    Next Hcr
    
End Sub


.
 
Ömer' Alıntı:
Merhaba,

Bu şekilde deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE,AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        If Hcr.Column < 32 Then
            Prog = "Prog_a" & Hcr.Row - 1
            Application.Run CStr(Prog)
        Else
            Prog = "Prog_b" & Hcr.Row - 1
            Application.Run CStr(Prog)
        End If
    Next Hcr
    
End Sub


.
Genişletmek için tıkla ...

Allah razı olsun. Çok çok teşekkürler. Deneyip sonucu en kısa sürede yazacam. şimdilik çalışıyor gibi ancak bilgisayar yoğun olduğundan 1 işlem 2 dk sürüyor. Uygun vakitte yazacağım tekrardan teşekkürler.
 
Merhaba

Merakımı maruz görün, her ne kadar 100 küsür kod yazmış olsanız bile bu kodları tek 1 kod olarak düzenlemeyi neden düşünmüyorsunuz?

Gördüğüm kadarıyla;
Kod: 
For S2SAT = 45 To 45
For S2SÜT = 4 To 389
For S1SAT = 2 To 2
For S1SÜT = 20 To 32

Kod: 
For S2SÜT = 4 To 389
Kod: 
For S1SAT = 2 To 2
Bu ikisi sabit ancak
Kod: 
For S2SAT = 45 To 45
Kod: 
For S1SAT = 2 To 2
Bu ikisi değişken.
Değişken olanlar da veri girişi yapılan satıra bağlı.
Örneğin, satir = Target.Row ile veri girişi yapılan satır nosunu alsanız ve bunu
Kod: 
S2SAT = satir + 3
S1SAT = satir - 1
şeklinde kullanarak tek bir kod haline getirseniz olmaz mı?

Malzeme listenize örneğin, Kaçak Akım Rölesi ilave etmeniz gerektiğinde, buna bağlı olarak satır veya sütun ilave edecekseniz 100 küsür kod için revizyon mu yapacaksınız?
Nasıl ki Worksheet_Change altındaki yüzlerce koddan kurtuldunuz diğer kodlardan da kurtulmanın yolunu arayın.
 
uzmanamele' Alıntı:
Merhaba

Merakımı maruz görün, her ne kadar 100 küsür kod yazmış olsanız bile bu kodları tek 1 kod olarak düzenlemeyi neden düşünmüyorsunuz?

Gördüğüm kadarıyla;
Kod: 
For S2SAT = 45 To 45
For S2SÜT = 4 To 389
For S1SAT = 2 To 2
For S1SÜT = 20 To 32

Kod: 
For S2SÜT = 4 To 389
Kod: 
For S1SAT = 2 To 2
Bu ikisi sabit ancak
Kod: 
For S2SAT = 45 To 45
Kod: 
For S1SAT = 2 To 2
Bu ikisi değişken.
Değişken olanlar da veri girişi yapılan satıra bağlı.
Örneğin, satir = Target.Row ile veri girişi yapılan satır nosunu alsanız ve bunu
Kod: 
S2SAT = satir + 3
S1SAT = satir - 1
şeklinde kullanarak tek bir kod haline getirseniz olmaz mı?

Malzeme listenize örneğin, Kaçak Akım Rölesi ilave etmeniz gerektiğinde, buna bağlı olarak satır veya sütun ilave edecekseniz 100 küsür kod için revizyon mu yapacaksınız?
Nasıl ki Worksheet_Change altındaki yüzlerce koddan kurtuldunuz diğer kodlardan da kurtulmanın yolunu arayın.
Genişletmek için tıkla ...

Arkadaşımız takıldığı konudan dışarı çıkamıyor, hep olumsuz bakıyordu. Nihayet derdini anladık ve kodları kısalttık.

Israrla son sorunu genel yanıtladım, kendisi bulsun diye fakat onu da Ömer bey yaptı :)

Sizin eleştirdiğiniz konuda da soru gelir diye bekledim ama ısrarla sormadı.

Bende sesimi çıkartmadım :)

Satır satır kod yazmanın yanlış olduğunu programın bakımını yaptığı anda anlayacak arkadaşımız.

En iyi öğrenmek sorun çözmekle olur.
 
Yardımlarınız için allah razı olsun. Haklısınız kodları cok yazdım bununda nedeni 1200 satır x 900 sütün işlem gerekmesi dosyanın asıl kodu:
Kod: 
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim S1SAT As Long, S1SÜT As Long, _
S2SAT As Long, S2SÜT As Long
Set S1 = Sheets("VERİ")
Set S2 = Sheets("YENİ MALZEME MUTABAKATI")
S2.Range("D37:N" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For S2SAT = 37 To S2.Cells(Rows.Count, "A").End(xlUp).Row
For S2SÜT = 4 To S2.Cells(4, Columns.Count).End(xlToLeft).Column
For S1SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For S1SÜT = 20 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
If S1.Cells(1, S1SÜT) Like "*Malzemenin Cinsi*" Then
If S2.Cells(S2SAT, "A") = S1.Cells(S1SAT, "A") And _
S2.Cells(4, S2SÜT) = S1.Cells(S1SAT, S1SÜT) Then
S2.Cells(S2SAT, S2SÜT) = S1.Cells(S1SAT, S1SÜT + 1)
End If: End If: Next: Next: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Yalnız bu Kod ile bir malzeme ismi ve adet girildiğinde ben 25 dk bekledim excel hala kodu bitirememişti kodu küçülterek tek satır için yaptığımda işimi gördü. Nedeni bu.
Korhan Ayhan ustamdan allah razı olsun daha kısa süren bir kod yazmıştı ancak o kod da da yanlış yazılan hüçre tek tek silinmesi gerekmekte coklu silindiğinde tek hüçredeki değer silmekteydi. Verileri yazacak olan sadece ben olsam tamam ancak farklı kişiler veri girişi yapacak.

İlla bu kod olacak diye diretmek demesekte en uygunu (bence) bu şekilde.

tekrardan çok teşekkür ederim sıkılmadan bıkmadan usanmadan yardımlarınızı esirgemediğiniz için.
 
Abilerim biraz fazla oluyorum dur belki özür dilerim.
Ancak ufak bi yardım daha rica etsem

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [U:U, W:W, Y:Y,AA:AA, AC:AC, AE:AE,AG:AG, AL:AL, AK:AK,AM:AM]) Is Nothing Or Target.Row < 2 Then Exit Sub
        
    Dim Prog    As String
    Dim Hcr     As Range
    
     Target.Select
    
    For Each Hcr In Selection
        If Hcr.Column < 32 Then
            Prog = "Prog_a" & Hcr.Row - 1
            Application.Run CStr(Prog)
        Else
            Prog = "Prog_b" & Hcr.Row - 1
            Application.Run CStr(Prog)
        End If
    Next Hcr
    
End Sub

kodunun çalıştırdığı prog_a ve prog_b makroları aynı dosya değilde aynı klasör içinde denem.xlsm isimli başka dosyada olsaydı nasılbir düzenleme yapacaktık acaba. Hata yaptıysam özür dilerim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst