Koşullara bağlı olarak kayıtların alınması

[1903emre34@gmail.com]

Merhaba,

Sayda 1'de açıklama kısmında metin içerisinde "yazılım" ifadesi var ise; bağlı bulunduğu kayıt sayfa2 getirilmesi için nasıl kod oluşturabiliiz (Örnek olarak sayfa2'de yapılmıştır) Örnek kısaltılarak verilmiştir.

 

[Ziynettin]

Merhaba,

Option Explicit
Sub aktar()
Dim a(), s1 As Worksheet, s2 As Worksheet
Dim s As Long, X As Long, Y As Byte
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
a = s1.Range("A2:H" & s1.Cells(Rows.Count, 1).End(3).Row)
    For X = 1 To UBound(a)
        If a(X, 6) Like "*YAZILIM*" Then
            s = s + 1
            For Y = 1 To UBound(a, 2)
                a(s, Y) = a(X, Y)
            Next Y
        End If
    Next X
s2.Range("A2:H" & Rows.Count).ClearContents
If s > 0 Then s2.[A2].Resize(s, UBound(a, 2)) = a
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

 

[1903emre34@gmail.com]

Hocam, teşekkürler, elleriniz sağlık,

 

[cems]

Alternatif olarak :

Aynı sayfada ayıklama ve en sağa yazmak için :

Sub ayikla()
Sheets("sayfa1").Select
son = Range("f65536").End(2).Row  'f sütunundaki son değeri buluyor
For f = 2 To son
veri = Cells(f, 6)
YAZILIM = InStr(1, veri, "YAZILIM")
TEMİZLİK = InStr(1, veri, "TEMİZLİK")
ABC = InStr(1, veri, "ABC")

If YAZILIM > 0 Then Cells(f, 10) = "YAZILIM"
If TEMİZLİK > 0 Then Cells(f, 10) = "TEMİZLİK"
If ABC > 0 Then Cells(f, 10) = "ABC"

Next f

MsgBox "dizilim yapıldı"
'Call Makro1
Thisworkbook.save
End Sub

Verdiğiniz örnekteki gibi aranan iki kelime bir satırda tesadüfü sıklıkla olmuyorsa ayıklama başarılı olur. Daha sonra ya siz süzgeç ile süzebilir ve başka sayfaya kopyalayabilir ya da

Kodun altındaki makro1 in de (') işaretini kaldırarak çalışmasına izin verebilirsiniz. Önemli olan sayfa1 sayfa 2 sayfa3 sayfa4 dosyada bulunmalıdır, daha sonra adları değişecektir.
Makro1 sayfa1 de süzme yaparak diğer sayfalara yapıştırıyor ve bitince sayfa1 e dönüyor.
Makro1 makrokaydet ile olduğu ve uzunluğundan dolayı buraya aktarmadım ama ekteki dosyada var.

Sayfa1 dışındakileri silip yeni 3 sayfa ekleyin ve adlarını sayfa2 3 4 olarak değiştirin, kodda (') işaretini kaldırın ,sonra çalıştırın.

Dediğim gibi 2 aranan kelime 1 satırda olmadığı sürece doğru yapacaktır.