Verİ Lİsteleme

[excelmaster]

Dosya ektedir. 1. sayfada A sütununda mağaza kodları, B sütununda da o mağazaya ait olan araç plakaları bulunmaktadır.

Örneğin ben D6 hücresine 333 yazdığımda E6 hücresinden başlayarak 333 nolu mağazaya ait plakalar sıralansın.

Plakalar sıralandıktan sonra da gider sınıflarının bulunduğu hücreler her zaman hemen altında sıralansın istiyorum.

Bu otomatik bir tablo olduğu için ben mağaza kodunu yazmak dışında hiçbir müdahalede bulunmayacağım.

İlginiz için teşekkür ederim.

 

[excelmaster]

..........

 

[Orion1]

Dosyanız ekte.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Range, ilk_adres As String, sat As Long
On Error Resume Next
If Intersect(Target, [D6]) Is Nothing Then Exit Sub
Range("D7:E65536").ClearContents
If Target.Value = "" Then Exit Sub
sat = 7
Set k = Sheets("Sayfa1").Range("A2:A65536").Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    ilk_adres = k.Address
    Do
        Cells(sat, "E").Value = k.Offset(0, 1).Value
        sat = sat + 1
        Set k = Sheets("Sayfa1").Range("A2:A65536").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> ilk_adres
End If
End Sub

 

[excelmaster]

Tam olarak olmadı.

Plakaların bittiği yerde otomatik olarak gider sınıflarının olduğu hücrelerin (Sayfa 2 D9:E12) sıralanması gerekir.

 

[Levent Menteşoğlu]

Aşağıdaki kodu sayfa2nin kod sayfasına kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a2]) Is Nothing Then Exit Sub
Set s1 = Sheets("sayfa1")
[b2:b65536].ClearContents
For a = 2 To s1.[a65536].End(3).Row
If s1.Cells(a, "a") = Target Then
c = c + 1
Cells(c + 1, "b") = s1.Cells(a, "b")
End If
Next
End Sub

 

[excelmaster]

Plakaların bittiği yerde otomatik olarak gider sınıflarının olduğu hücrelerin (Sayfa 2 D9:E12) sıralanması gerekir.

 

[01.hakan]

kodun açıklaması

Aşağıdaki kodu sayfa2nin kod sayfasına kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a2]) Is Nothing Then Exit Sub
Set s1 = Sheets("sayfa1")
[b2:b65536].ClearContents
For a = 2 To s1.[a65536].End(3).Row
If s1.Cells(a, "a") = Target Then
c = c + 1
Cells(c + 1, "b") = s1.Cells(a, "b")
End If
Next
End Sub

Öncelikle siteye emeği geçen her arkadaşıma teşekkür eder başarılar dilerim. Bu kodlar için de Levent Bey'e çok teşekkür ederim ben de faydalandım bu kodlardan ve çoka çok ilişkili bir veritabanı yapısında güzel sonuçlar çıkardım. Yalnız bu kodlarda (daha önce benzer kodlar da da görmüştüm, b sütünunun 65536 ıncı satırına kadar silme işleminin yapılma , döngünün de a sütüununun da veri olsun veya olmasın tüm satır sayısı kadar sürmesi bir zorunlulukmudur. İntersect fonksiyonu hakkında detaylı bilgi bulabilir miyim. Bu konularda yardımcı olabilirseniz sevinirim.

 

[Orion1]

Tam olarak olmadı.

Plakaların bittiği yerde otomatik olarak gider sınıflarının olduğu hücrelerin (Sayfa 2 D9:E12) sıralanması gerekir.

Sorduğunuz ilk soruda bu ayrıntı yoktu.
Dolayısı ile onu yapmadım.
Lütfen sorularınızı açıklayıcı ve net sorun.Burada yapamadı durumuna düşmeyelim boşu boşuna.Yapamayacak olsaydım zaten soruya hiç girmezdim?*?

 

[excelmaster]

Sorduğunuz ilk soruda bu ayrıntı yoktu.
Dolayısı ile onu yapmadım.
Lütfen sorularınızı açıklayıcı ve net sorun.Burada yapamadı durumuna düşmeyelim boşu boşuna.Yapamayacak olsaydım zaten soruya hiç girmezdim?*?

DOĞRUDUR, İLK SORUDA BÖYLE BİR AYRINTI YOKTU. O SORUYA GÖRE YAPMIŞ OLDUĞUNUZ DOĞRUYDU. ANCAK KONULAR BİRLEŞTİRİLDİĞİ İÇİN BÖYLE BİR YANLIŞ ANLAŞILMA ORTAYA ÇIKMIŞTIR.

 

[excelmaster]

Değerli yardımlarınızı bekliyorum.

 

[cenderus]

dosya ektedir

konu başlığına ait bulabildiğim dosya ektedir