Formülleri If Intersect ile makro haline getirme

[khthonik]

Merhabalar,

Excelim 3 sayfadan oluşuyor. Aynı sayfada yada sayfalar arasında düşeyara, çok etopla, birleştir gibi formülleri kullanıyorum. Örneğin formül [A2:A65536]*[B2:B65536]=[C2:C65536] ise makro a ve b değişkenine bağlı olarak formül gibi hesaplama yapsın, boşlarsa yapmasın... Amacım; excel satır sayım fazla olduğundan dolayı dosya boyutu ve kasmalardan kurtulmak için formüllerden makroya geçmektir.

Alttaki kodlarda yeşil olanlar çalışıyor, kırmızı olanlar çalışmıyor. Çözüm ve yönlendirme için yol gösterir misiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son

Set ws1 = Worksheets("Gelen")
Set ws2 = Worksheets("İmalat")

If Intersect(Target, Range([P2: P65536], [Q2:Q65536])) Is Nothing Then Exit Sub
If Target <> "" Then
Cells(Target.Row, "R") = Cells(Target.Row, "P") * Cells(Target.Row, "Q")
Else
Cells(Target.Row, "R") = Empty
End If

If Intersect(Target, Range([P2: P65536], [T2:T65536])) Is Nothing Then Exit Sub
If Target <> "" Then
Cells(Target.Row, "U") = Cells(Target.Row, "P") * Cells(Target.Row, "T")
Else
Cells(Target.Row, "U") = Empty
End If

If Intersect(Target, Range([A2:A65536], [M2:M65536])) Is Nothing Then Exit Sub
If Target <> "" Then
Cells(sat, "V") = Cells(sat, "A") & Cells(sat, "M")
Else
Cells(sat, "V") = Empty
End If

If Intersect(Target, Range([A2:A65536], [P2: P65536])) Is Nothing Then Exit Sub
If Target <> "" Then
Cells(Target.Row, "W") = WorksheetFunction.SumIf([A2:A65536], Cells(Target.Row, "A"), [P2: P65536])
Else
Cells(Target.Row, "W") = Empty
End If

If Intersect(Target, Range([A2:A65536], ws2.[I2:I65536])) Is Nothing Then Exit Sub
If Target <> "" Then
Cells(Target.Row, "X") = WorksheetFunction.SumIf(ws2.[A2:A65536], Cells(Target.Row, "A"), ws2.[I2:I65536])
Else
Cells(Target.Row, "X") = Empty
End If

If Intersect(Target, Range([W2:W65536], [X2:X65536])) Is Nothing Then Exit Sub
If Target <> "" Then
Cells(Target.Row, "Y") = Cells(Target.Row, "W") - Cells(Target.Row, "X")
Else
Cells(Target.Row, "Y") = Empty
End If

If Intersect(Target, Range([A2:A65536], [Y2:Y65536])) Is Nothing Then Exit Sub
If Cells(Target.Row, "Y") <> 0 Then
Cells(Target.Row, "Z") = Cells(Target.Row, "M")
Else
Cells(Target.Row, "Z") = Empty
End If

son:
End Sub

Saygılar

 

[çıtır]

Bu şekilde olmalı.Yazımda hata var sanırım.

If Intersect(Target, ([P2:P65536,T2:T65536])) Is Nothing Then Exit Sub

 

[khthonik]

Değişiklikleri dediğiniz gibi yaptım. Ama sorun düzelmedi. (1. If Intersect i yapıyor, 2. If Intersect i yarım yapıyor, diğerlerini hiç yapmıyor)

 

[çıtır]

Değişiklikleri dediğiniz gibi yaptım. Ama sorun düzelmedi. (1. If Intersect i yapıyor, 2. If Intersect i yarım yapıyor, diğerlerini hiç yapmıyor)

Aynı sub da birden fazla Change olayının çalışması yazdığınız şekilde olmaz. sat yazılmış atama yapılmamış birden fazla hatalar var gördüğüm kadar,dosyanın çalışma mantığını bilmediğim için bu kadar yazabiliyorum

 

[YUSUF44]

Kodlarınızda gördüğüm kadarıyla aynı "target" için farklı kod blokları kullanmışsınız. Bildiğim kadarıyla bu şekilde bir kullanım uygun değil. Yani makro P2 hücresine hangi işlemi yapacağını nerden bilecek, ilk kod bloğundaki komutlarımı, ikincideki mi, üçüncüdeki mi?

If Intersect(Target, Range([P2: P65536], [Q2:Q65536])) Is Nothing Then Exit Sub
...
...


yerine

If Intersect(Target, [P2: P65536]) Is Nothing Then goto 10
.....
....

10:
If Intersect(Target, [Q2:Q65536]) Is Nothing Then goto 20
.....
.....

20:
If Intersect(Target, [R2:R65536]) Is Nothing Then Exit Sub
....
....


Mantığıyla kodları yazmalısınız. Bir targete farklı işlemler yapılacaksa o target bloğunun altına if ile şartlar ekleyip kodu düzenlemelisiniz.

 

[khthonik]

Aynı sub da birden fazla Change olayının çalışması yazdığınız şekilde olmaz. sat yazılmış atama yapılmamış birden fazla hatalar var gördüğüm kadar,dosyanın çalışma mantığını bilmediğim için bu kadar yazabiliyorum

"sub da birden fazla Change olayının çalışması yazdığınız şekilde olmaz" formüllerimi makro olarak örnek kodumdaki gibi nasıl çalışabilirim. Yada başka yolu var mıdır.
"sat yazılmış atama yapılmamış" Target.Row a eşitlemiştim. Kod a ilave etmemişim.
"dosyanın çalışma mantığını bilmediğim için bu kadar yazabiliyorum" gerekirse exceli ekleyeceğim. Ama yapmak istediğim anlaşıldıysa yol gösterilirse önce kendim uğraşacağım.

 

[khthonik]

Kodlarınızda gördüğüm kadarıyla aynı "target" için farklı kod blokları kullanmışsınız. Bildiğim kadarıyla bu şekilde bir kullanım uygun değil. Yani makro P2 hücresine hangi işlemi yapacağını nerden bilecek, ilk kod bloğundaki komutlarımı, ikincideki mi, üçüncüdeki mi?

If Intersect(Target, Range([P2: P65536], [Q2:Q65536])) Is Nothing Then Exit Sub
...
...


yerine

If Intersect(Target, [P2: P65536]) Is Nothing Then goto 10
.....
....

10:
If Intersect(Target, [Q2:Q65536]) Is Nothing Then goto 20
.....
.....

20:
If Intersect(Target, [R2:R65536]) Is Nothing Then Exit Sub
....
....


Mantığıyla kodları yazmalısınız. Bir targete farklı işlemler yapılacaksa o target bloğunun altına if ile şartlar ekleyip kodu düzenlemelisiniz.

Teşekkür ederim. Dedikleriniz doğrultusunda kodlarımı alttaki gibi revize ederek çözüme ulaştım. Diğer sayfalarda çalışmalarıma devam ediyorum. Tekrar bilgilerinize başvurabilirim. Yardımlarınızı esirgemezseniz sevinirim. Güncel kodları başkalarına da yardımcı olması için tekrar paylaşacağım.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Volatile True
Application.Calculation = xlCalculationAutomatic
On Error Resume Next

Set ws1 = Worksheets("Gelen")
Set ws2 = Worksheets("İmalat")
    sat = Target.Row

    If Intersect(Target, [P2:P65536]) Is Nothing Then GoTo 1
    If Target <> "" Then
    Cells(sat, "R") = Cells(sat, "P") * Cells(sat, "Q")
    Else
    Cells(sat, "R") = Empty
    End If
1:
    If Intersect(Target, [Q2:Q65536]) Is Nothing Then GoTo 2
    If Target <> "" Then
    Cells(sat, "R") = Cells(sat, "P") * Cells(sat, "Q")
    Else
    Cells(sat, "R") = Empty
    End If
2:
    If Intersect(Target, [P2:P65536]) Is Nothing Then GoTo 3
    If Target <> "" Then
    Cells(sat, "U") = Cells(sat, "P") * Cells(sat, "T")
    Else
    Cells(sat, "U") = Empty
    End If
3:
    If Intersect(Target, [T2:T65536]) Is Nothing Then GoTo 4
    If Target <> "" Then
    Cells(sat, "U") = Cells(sat, "P") * Cells(sat, "T")
    Else
    Cells(sat, "U") = Empty
    End If
4:
    If Intersect(Target, [A2:A65536]) Is Nothing Then GoTo 5
    If Target <> "" Then
    Cells(sat, "V") = Cells(sat, "A") & Cells(sat, "M")
    Else
    Cells(sat, "V") = Empty
    End If
5:
    If Intersect(Target, [M2:M65536]) Is Nothing Then GoTo 6
    If Target <> "" Then
    Cells(sat, "V") = Cells(sat, "A") & Cells(sat, "M")
    Else
    Cells(sat, "V") = Empty
    End If
6:
    If Intersect(Target, [P2:P65536]) Is Nothing Then GoTo 8
    If Target <> "" Then
    Cells(sat, "W") = WorksheetFunction.SumIf([A2:A65536], Cells(sat, "A"), [P2:P65536])
    Else
    Cells(sat, "W") = Empty
    End If
7:
    If Intersect(Target, [P2:P65536]) Is Nothing Then GoTo 8
    If Target <> "" Then
    Cells(sat, "W") = WorksheetFunction.SumIf([A2:A65536], Cells(sat, "A"), [P2:P65536])
    Else
    Cells(sat, "W") = Empty
    End If
8:
    If Intersect(Target, [P2:P65536]) Is Nothing Then GoTo 10
    If Target <> "" Then
    Cells(sat, "X") = WorksheetFunction.SumIf(ws2.[A2:A65536], Cells(sat, "A"), ws2.[I2:I65536])
    Else
    Cells(sat, "X") = Empty
    End If
9:
    If Intersect(Target, [P2:P65536]) Is Nothing Then GoTo 10
    If Target <> "" Then
    Cells(sat, "X") = WorksheetFunction.SumIf(ws2.[A2:A65536], Cells(sat, "A"), ws2.[I2:I65536])
    Else
    Cells(sat, "X") = Empty
    End If
10:
    If Intersect(Target, [W2:W65536]) Is Nothing Then GoTo 11
    If Target <> "" Then
    Cells(sat, "Y") = Cells(sat, "W") - Cells(sat, "X")
    Else
    Cells(sat, "Y") = Empty
    End If
11:
    If Intersect(Target, [X2:X65536]) Is Nothing Then GoTo 12
    If Target <> "" Then
    Cells(sat, "Y") = Cells(sat, "W") - Cells(sat, "X")
    Else
    Cells(sat, "Y") = Empty
    End If
12:
    If Intersect(Target, [M2:M65536]) Is Nothing Then GoTo 13
    If Cells(sat, "Y") <> 0 Then
    Cells(sat, "Z") = Cells(sat, "M")
    Else
    Cells(sat, "Z") = Empty
    End If
13:
    If Intersect(Target, [Y2:Y65536]) Is Nothing Then Exit Sub
    If Cells(sat, "Y") <> 0 Then
    Cells(sat, "Z") = Cells(sat, "M")
    Else
    Cells(sat, "Z") = Empty
    End If
  
Application.ScreenUpdating = True
End Sub

 

[YUSUF44]

Aklınızda bulunsun, If, With, For/Next gibi kodlarda alt kodları bir miktar içerden yazarsanız herhangi bir hata verdiğinde düzeltmeniz daha kolay olur.

If
    For
        With
            kodlar
        End with
    Next
End If

gibi.

 

[khthonik]

Merhabalar,
Aynı excelimde https://www.dosyaupload.com/isdY şöyle bir şey daha yapmak istiyorum.
İmalat sayfası A sütunundaki değer, gelen sayfasındaki A sütununda varsa; gelen sayfası Z sütunundaki ilgili değerleri, imalat sayfasındaki D sütununa ilgili satıra benzersiz listeleme yap...
Koşullu benzersiz listeleme (veri doğrulama) gerekiyor. Ama makro ile nasıl yapılacağını hayal bile edemedim. Yardımcı olursanız sevinirim.
Saygılar..

 

[khthonik]

Günaydınlar,
Yukarıdaki konuda fikri olan yada çözüm sunabilen var mı?
İyi günler

 

[YUSUF44]

Konuyu anlamadım maalesef, örneklerle açıklar mısınız?

 

[khthonik]

Gönderdiğim excelde, "İmalat" sayfasında "B2:B65536" sütununun her hücresine açılır pencere (benzersiz veri doğrulama) yapmak istiyorum. Bu açılır penceredeki gösterilecek veriler, solundaki A hücresindeki değere bağlı olacaktır.
Örneğin; "İmalat" sayfası "A100" hücresindeki değer, "Gelen" sayfası "A2:A65536" sütununda 10 tane varsa "Gelen" sayfasındaki "Z2:Z65536" sütunundaki bu 10 taneye ait değeri "İmalat" sayfasında "B100" hücresinde açılır pencerede göster şeklindedir.
Benzer uygulamayı şartlı olarak 12 satır için kullanıyorum. Ama A ve B sütunlarındaki 12 satırın hücrelerine Ad Tanımla yaptım. Bu yüzden Ad Yöneticisinde 12 tane formül var. Sonra Ad Yöneticisi ndeki bu formülleri her hücreye veri doğrulama yaptım. Şuan ki durum çok farklı Ad yöneticisine 65536 tane formül yaz vs vs..