Veri sayfasındaki firma bilgilerini ara bul

[bilalakdeniz]

Veri sayfasında firmalar hakkında yazdığım notları liste sayfasında sadece o firmaya ait bütün notları getirmesini istiyorum. Bir nevi veri sayfasında süzmek gibi.

 

[N.Ziya Hiçdurmaz]

yanıt

LİSTE Sayfasının kod bölümüne kopyalayınız

Private Sub Worksheet_Change(ByVal Target As Range)
s = 4
If Intersect(Target, [a4:a5000]) Is Nothing Then Exit Sub
son = Sheets("VERİ").Cells(65536, "a").End(xlUp).Row
For sat = 4 To Cells(65536, "a").End(xlUp).Row
Set bul = Sheets("VERİ").Range("A2:A" & son).Find(Cells(sat, "a"), , xlValues, xlWhole)
If Not bul Is Nothing Then
adres = bul.Address
Do
Cells(s, "b") = Sheets("VERİ").Cells(bul.Row, "d").Value
Cells(s, "c") = Sheets("VERİ").Cells(bul.Row, "e").Value
s = s + 1
Set bul = Sheets("VERİ").Range("A2:A" & son).FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
Next
End Sub

 

[bilalakdeniz]

Kitaba entegre yapamadım. Göndermiş olduğum dosyaya koyabilirmisiniz

 

[Orion1]

Dosyanız ektedir.

Sub dusunceleri_getir_59()
Dim sh As Worksheet, sat As Long
Range("A3:E65536").Clear
If Range("A1").Value = "" Then Exit Sub
Application.ScreenUpdating = False
Set sh = Sheets("Veri")
sat = sh.Cells(65536, "C").End(xlUp).Row
If sat < 2 Then
    Application.ScreenUpdating = True
    Exit Sub
End If
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=3, Criteria1:=Range("A1").Value
sh.Range("A1").CurrentRegion.Copy Range("A3")
sh.Range("A1").AutoFilter
Application.ScreenUpdating = True
MsgBox "İşlem tamalandı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[bilalakdeniz]

Evren bey çok teşekkür ederim ama, olmayan bilgileri silmiyor. Bakabilirmisiniz

 

[Orion1]

Veri sayfasında firmalar hakkında yazdığım notları liste sayfasında sadece o firmaya ait bütün notları getirmesini istiyorum. Bir nevi veri sayfasında süzmek gibi.

Evren bey çok teşekkür ederim ama, olmayan bilgileri silmiyor. Bakabilirmisiniz

Anlamadım.
Neyi silecek.
Siz silme konusu ile ilgili bir şey istememiştiniz.Bakın yukarıda sorunuzu yazdım.
Benmi yanlış ım acaba sizimi yanlış.Anlayamadm.
Yazdığım kodlar bu istediğinizi yapıyor.

 

[bilalakdeniz]

A1 hücresine 1002 yazdığımda 1. Satıra doğru bilgiyi getiriyor. Ama 2. Ve 3. Satırda 1001 in bilgileri hala duruyor.

 

[Orion1]

Evren bey çok teşekkür ederim ama, olmayan bilgileri silmiyor. Bakabilirmisiniz

Evet doğru.
Düzenledim.
Dosyaı 4 nolu mesajdan tekrar indirebilirsiniz.
Birkaç çeşit daha veri girseydiniz ben onu farketçektim.
Siz böyle yapınca olmazdı ama autofilter geniş tutunca oldu silmedi orasını ben çünkü kodda daha önceki duruma göre silmiştim.

 

[bilalakdeniz]

çok güzel olmuş, elinize sağlık, teşekkürler

 

[Orion1]

çok güzel olmuş, elinize sağlık, teşekkürler

Rica ederim.
İyi çalışmalar.

 

[bilalakdeniz]

Sayın, Evren Gizlen, yapmış olduğunuz dosyayı kullanmaktayım yalnız bir ricam olacak, Değer olmayan hücreleri temizlemiyor. ne yapmam gerekiyor. En fazla süzdüğüm satır sayısının biçimi duruyor. kenar çizgileri gibi.

 

[Orion1]

Sayın, Evren Gizlen, yapmış olduğunuz dosyayı kullanmaktayım yalnız bir ricam olacak, Değer olmayan hücreleri temizlemiyor. ne yapmam gerekiyor. En fazla süzdüğüm satır sayısının biçimi duruyor. kenar çizgileri gibi.

4 numralı mesajda günceledim.
Bakın bakalım olmuşmu.

 

[bilalakdeniz]

evet olmuş çok teşekkür ederim