SHEETLER ARASINDAKİ BİLGİLERİN EŞLEŞMESİ, COMMENT YARATILMAS

[bono]

Arkadaşlar çok büyük bir data üzerinde çalışmak zorundayım . En az 30.000 kayıt. Bu nedenle aşağıda yazdığım şeyleri tek tek yaptırmak gerçekten çok zaman alıyor. Bunu bir makro yardımı ile yaptırmam gerekmekte. Ekte mini bir örnek dosya koyuyorum. Bana yardımcı olursanız sevinirim

1- sheet 1 de yer alan kişilere ait notların sheet2 de aratılması ve aynı kişinin aynı nota sahip bir kaydı varsa sheet2 deki "bu dönemki tam not"un sheet1 dekiönceki dönem tam not kısmına yazdırılması. (Sadece aynı nota sahip bir kayıt varsa tam not gelecek , yoksa "0" yazılacak)

2- KRİTER sheetinde yer alan not açıklamaları sheet1 deki "not" ların üstüne comment (hide lı olarak) olarak gelmesi. (Insert comment ile tek tek yapınca daha büyük olduğundan çok sorun oluyor.)

 

[Levent Menteşoğlu]

Aşağıdaki kodu sheet1 isimli sayfada bir butona bağlayarak çalıştırın.

[vb:1:fb18079073]Sub listele()
On Error Resume Next
Set s1 = Sheets("sheet1")
Set s2 = Sheets("sheet2")
deg = Array("ZAYIF", "ORTA", "İYİ")
For a = 2 To s1.[a65536].End(3).Row
s1.Cells(a, "b").AddComment
s1.Cells(a, "b").Comment.Visible = False
s1.Cells(a, "b").Comment.Text Text:=deg(s1.Cells(a, "b") - 1)
sat = s2.[a1:a65536].Find(s1.Cells(a, "a")).Row
If s1.Cells(a, "b") = s2.Cells(sat, "b") Then s1.Cells(a, "d") = s2.Cells(sat, "c")
Next
End Sub[/vb:1:fb18079073]

 

[bono]

levent bey çok teşekkürler yardımlarınız için ancak bir hata çıkıyor. comment ler doğru gelmesine karşılık, önceki dönem notlar sheet1 de hatalı çıkıyor. mesela mehmet in sheet 1 deki 3 notuna karşılık sheet2 de 5010 gelmesi gerekir ama gelmiyor. diğer hatalardan biri ise ceyda ve zerrinin sheet2 de karşılığı olmamasına rağmen not geliyor.

size zahmet olmazsa bir kez daha bakabilirmisiniz?

 

[kundakci]

Merhaba
Levent bey ben düzeltiyorum. kusura bakmayın

aşağıdaki satırı değiştirin

If s1.Cells(a, "b") = s2.Cells(sat, "b") And s1.Cells(a, "a") = s2.Cells(sat, "a") Then s1.Cells(a, "d") = Sheets("sheet2").Cells(sat, "c")

kolay gelsin

 

[Levent Menteşoğlu]

Levent bey ben düzeltiyorum. kusura bakmayın

Rica ederim. Düzeltme için teşekkür ederim. Bu tip durumlarda lütfen müdahele etmekten çekinmeyin, bunu daha önceden de çok kez ifade ettim. İstediğiniz şekilde düzeltebilirsiniz.

 

[bono]

arkadaşlar yardımlarınız için çok teşekkür ederim. ancak yine bir sorun var. mehmet 3 iki sheet tede var ancak sheet1 e sheet2 deki bilgi gelmiyor. sebebi ne olabilir?

 

[bono]

Arkadaşlar bir sorun daha var.

Oda Kriter dosyasında yer alan mini bir örnekti. Asıl kriterler birbirlerini sıra ile takip etmeyen ve bir çok rakamdan oluşmakta. Ve her makro çalıştıracağım zamanlarda değişme olasılığı bulunmaktadır. Comment ler oluşturulurken önceki dönem notlarını diğer sayfadan eşleştirme ile çektiğim gibi kriterleride kriter sayfasından çekmem gerekiyor. Yani rakamlar uyuşuyorsa karşısında yazan şeyi commente alması gerekiyor. Ben bir kaç şey denedim ama hep hata mesajı aldım. Bu konuda da çözüm geliştirebilme konusunda bana yardımcı olursanız sevinirim

 

[bono]

leventm, kundakci

sizlere çok zahmet vermeyeceksem bana yardımcı olabilirmisiniz yine. Yukarıdaki yazdığım sorunları gidermek için çok çaba sarfettim ama benim bilgim sadece boş yere uğraşmaya yaradı.

 

[bono]

arkadaşlar

bu makro benim için gerçekten çok önemli. Daha doğrusu 1 günde bitiremediğim bir raporun bir kaç saate inmesine yardımcı olacak. Rapor tarihi yaklaştığından acilen yardımlarınızı rica ediyorum

 

[Levent Menteşoğlu]

Kodu aşağıdaki ile değiştirerek deneyin.

[vb:1:3669f48a0b]Sub listele()
On Error Resume Next
Set s1 = Sheets("sheet1")
Set s2 = Sheets("sheet2")
deg = Array("ZAYIF", "ORTA", "İYİ")
son = s2.[a65536].End(3).Row
For a = 2 To s1.[a65536].End(3).Row
s1.Cells(a, "b").AddComment
s1.Cells(a, "b").Comment.Visible = False
s1.Cells(a, "b").Comment.Text Text:=deg(s1.Cells(a, "b") - 1)
s1.Cells(a, "d") = Evaluate("=SUMPRODUCT((Sheet2!A2:A" & son & "=" & s1.Cells(a, "a").Address & ")*(Sheet2!B2:B" & son & "=" & s1.Cells(a, "b").Address & ")*(Sheet2!C2:C" & son & "))")
Next
End Sub[/vb:1:3669f48a0b]

 

[bono]

leventm

Ellerine sağlık, eşleşme harika olmuş.

Birde şu comment eklemeye çözüm getirme şansımız varmı? Sheet3 den almıyor bu makroda da comment bilgilerini. Sheet 3 e girdiğim herhangi bir şeyi comment olarak yaratmasını istemek imkansız bir istekmi olur.

Şimdiden teşekkürler uğraşların için.