Gruba göre malzemeyi almak

[CenTay]

Selamlar, dosyamda açıklamaya çalıştım, yardımlarınızı bekliyorum..

http://s3.dosya.tc/server6/f5s4es/Gruba_gore_malzemeleri_getirmek.xls.html

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz. B1 hücresi değiştikçe otomatik olarak listeleme yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Malzemeler")
son = s2.Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(s2.Range("B2:B" & son), Target) = 0 Then Exit Sub
eski = Cells(Rows.Count, "B").End(3).Row
Range("A2:B" & eski).ClearContents
For i = 2 To son
    If s2.Cells(i, "B") = Target Then
        yeni = Cells(Rows.Count, "B").End(3).Row + 1
        Cells(yeni, "A") = yeni - 1
        Cells(yeni, "B") = s2.Cells(i, "C")
    End If
Next
Application.EnableEvents = True
Target.Select

End Sub

 

[CenTay]

Hocam selamlar kodu hemen hemen her sayfada denedim hata vermedi ama bul sayfası B2 ye de malzeme gelmedi ben yanlış mı yaptım dedim ama denemeleri olmadı

 

[YUSUF44]

Kodun düzgün çalışması için B1 hücresine malzemeler sayfasındaki gibi Grup ismini büyük harfle yazma gerekiyordu. Ayrıca kodda eski verilerin silinmesi kısmında bir bir hata vardı. Her iki durum içinde kodda düzenleme yaptım, aşağıdaki gibi kullanın:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Malzemeler")
son = s2.Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(s2.Range("B2:B" & son), Target) = 0 Then Exit Sub
eski = WorksheetFunction.Max(2, Cells(Rows.Count, "B").End(3).Row, 2)
Range("A2:B" & eski).ClearContents
For i = 2 To son
    If UCase(Replace(Replace(s2.Cells(i, "B"), "i", "İ"), "ı", "I")) = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I")) Then
        yeni = Cells(Rows.Count, "B").End(3).Row + 1
        Cells(yeni, "A") = yeni - 1
        Cells(yeni, "B") = s2.Cells(i, "C")
    End If
Next
Application.EnableEvents = True
Target.Select

End Sub

 

[CenTay]

Hocam olmadı sorun devam ediyor yaptığım ise son kodu bul sayfasına kayıt edip B1 den grup yazdım bendemi hata var hocam

 

[YUSUF44]

İlk kullanış için Bul sayfasında B2 den itibaren birkaç hücre doldurup öyle deneyin.

 

[CenTay]

Hocam zahmet verip duruyorum ne yaptım olmadı mümkünse bir dosya eklerseniz memnun olacağım herşey için sağolun.makro olmazsa formülde olur

 

[YUSUF44]

Buyrun:

https://drive.google.com/file/d/0B43WMUs21VpfekRocjFwVWdHZmc/view?usp=sharing

 

[CenTay]

Buyrun:

https://drive.google.com/file/d/0B43WMUs21VpfekRocjFwVWdHZmc/view?usp=sharing

Hocam selamlar, Sanırım sorun bende dosyanızı da indirdim ama sonuç değişmedi hem sizede zahmet verip duruyorum buda beni mahçup ediyor

 

[YUSUF44]

O dosyadayken bir modüle aşağıdaki kodları yapıştırıp çalıştırın, sonra tekrar deneyin:. Belki olaya bağlı çalıştırma pasiflenmiştir:

sub aktif()
Application.EnableEvents = true
end sub()

 

[CenTay]

Hocam selamlar maalesef olmadı.Yeni dosya açtım kodları kopyaladım ne yaptım olmadı yani bul sayfasında B2 de hiç hareket olmuyor mümkünse formülleyin hocam teşekkür ederim.

 

[YUSUF44]

Formülle nasıl yapılır bilmiyorum. Olmayan dosyayı dosya paylaşır mısınız?

 

[CenTay]

Formülle nasıl yapılır bilmiyorum. Olmayan dosyayı dosya paylaşır mısınız?

Selam hocam, ekliyorum ve teşekkür ediyorum.Sağolun.

http://dosyayukle.net/download/7a091bf5bc7590f03e31813ccf22cbe7.html

 

[YUSUF44]

Aktif kodunu aşağıdakiyle değiştirip çalıştırın. Bende de ilk çalışmadı ama sonra böyle yapınca çalıştı:

Sub aktif()
Application.EnableEvents = False
Application.EnableEvents = True
End Sub

 

[CenTay]

Merhaba hocam nihayet oldu sağolasın Orj. Dosyadan malzemeler sayfasında ; a sütunu sıra , b sütunu tarh, c sütunu grup ve d sütunu malzeme.Bu duruma göre kodda nereleri düzeltebilirim. Tekrar teşekkür ediyorum.

 

[YUSUF44]

Örnek dosyanızı niye orjinalden farklı hazırlıyorsunuz ki? O kadar boşa mı uğraştık yani! Örnek dosyanızı orjinaline uygun olarak hazırlayıp nasıl bir sonuç istediğinizi örnekle gösterirseniz daha iyi olur.

 

[CenTay]

Selam hocam haklısınız gözümden kaçırmışım, özür dilerim bu haliyle kalsın tekrar teşekkür ediyorum hakkını helal et.

 

[YUSUF44]

Helal olsun, ne demek.

Eğer işinizi gördüyse ne iyi, görmediyse sormaktan çekinmeyin.

 

[CenTay]

Helal olsun, ne demek.

Eğer işinizi gördüyse ne iyi, görmediyse sormaktan çekinmeyin.

Sağol hocam, orj.dosyaya uyarlayamadım, ya format değiştirecem yada arşivde güzel bie dosya olarak yerini alacak.Zahmetleriniz için teşekkür ederim.Başka bir başlıkla formülle çare arayacağım, oldu oldu olmadıysada yapacak bi şey yok.sağlıcakla kalınız.