sütunlara filtre uygulayıp hepsini başka bir sütuna yapıştıran makro

[fhrsym]

arkadaşlar içinde aileyle ve yalnız yaşıyor geçen kelimeler olan hücreleri tek seferde filtreleyip bulunan sonuçları başka bir sütuna yapıştıracak bi makro yazılabilir mi?

Aşağıda benim yazmaya çalışıp da beceremediğim kodlar var... daha iyi anlaşılabilmesi amacıyla örnek bi dosyada ekliyorum

Şimdiden yardımlarınız için teşekkür ederim...


Sub seçaktar()
'
' Makro2 Makro
'

'
Dim i As Integer
For i = 1 To 50
ActiveSheet.Range("$A$1:$BL$205").AutoFilter Field:=i, Criteria1:=
"=*yalnız yaşıyor*", Operator:=xlOr, Criteria2:="=*ailesiyle yaşıyor*"
If i = 1 Then
Range("A2:A202").Select
If i = 2 Then
Range("B2:B202").Select
If i = 3 Then
Range("C2:C202").Select
End If

Selection.Copy
Range("CV2").Select
ActiveWindow.SmallScroll Down:=-42
Range("CO2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-27
Next i
End Sub

 

[Necdet]

Merhaba,

Kodları boşverin de ne yapmak istediğinizi ayrıntılı açıklarsanız daha hızlı yanıt alabilirsiniz.

 

[fhrsym]

örnek dosyada gönderdiğim datalar gibi ilk üç sütundaki datalara teke tek filtre uygulayıp "çocuğu var", "cocuğu yok" içeren hücrelerin hepsini tek bi sütunda mesela D sütunun da toplayan bi makro yazılabilir mi?

 

[fhrsym]

yadım edebilecek bir arkadaş yok mu acaba?

 

[Necdet]

Merhaba,

Konu pek anlaşılmıyor ki kim yardımcı olabilsin?
Örneğin A2 hücresi "İSTANBUL’DA AİLESİYLE YAŞIYOR" içeriyor.

Bu hücrenin içinde "AİLESİYLE YAŞIYOR" sözcükleri geçtiği için sadece A2 hücresi mi başka bir yere aktarılacak yoksa 2 satır olduğu gibi mi aktarılacak?

 

[fhrsym]

Evet eğer hücrenin içinde yalnız yaşıyor veya ailesiyle yaşıyor ifadeleri varsa o hücre kopyalanıp D sütununa yapıştırılacak. Ancak yapıştırılırken hücre kaçıncı satırda ise D sütununun ilgili satırına yapıştırılacak. Bu şekilde yapılabilir mi?

 

[Necdet]

Evet eğer hücrenin içinde yalnız yaşıyor veya ailesiyle yaşıyor ifadeleri varsa o hücre kopyalanıp D sütununa yapıştırılacak. Ancak yapıştırılırken hücre kaçıncı satırda ise D sütununun ilgili satırına yapıştırılacak. Bu şekilde yapılabilir mi?

Diyelimki A sütununda ilgili şartı sağlayan bir hücre var ve aynı şartı sağlayan bir başka hücrede c sütununda var (aynı satırda) bu durumda D satırında durum ne olur? birini diğerinin üzerine yazar.

Böyle olasılık olur mu?

Sub BulveAktar()
    
    Dim c   As Range, _
        Adr As String, _
        i   As Long, _
        j   As Integer, _
        Aranan
    
    i = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Sayfadaki Son Satır Numarasını Verir
    Aranan = Array("AİLESİYLE YAŞIYOR", "YALNIZ YAŞIYOR")                       'Aranacak sözcükler
    
    Range("D:D").ClearContents
    
    For j = 0 To UBound(Aranan)
    
        With Range("a1:c" & i)
            Set c = .Find(Aranan(j), LookIn:=xlValues)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Range("D" & c.Row) = c.Value
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    
    Next j
        
End Sub

 

[fhrsym]

hayır necdet bey öyle bir olasılık yok Elimde Bu şekilde 50000 data var datalarda kiminle yaşadıklarını ayırmam gerekiyor ama kminle yaşadıkları karışmış durumda... Yani her satırda bir tane kiminle yaşadığı ile ilgili bilgi var ama Bu ilgili satırın A, B, C, D,...... Z sütunlarından herhangi birinde olabilir...

 

[Necdet]

Verdiğim kodları denediniz mi?

 

[fhrsym]

evet ama hiç bir işlem yapmadı kod...

 

[Necdet]

evet ama hiç bir işlem yapmadı kod...

bende neden çalışıyor?

 

[Civan Jack]

Kodlarda sorun görünmüyor.

 

[fhrsym]

şimdi oldu ilkinde olmamıştı şimdi oldu hemde tam istediğim gibi oldu... elinize sağlık

 

[fhrsym]

oldu necdet bey çok teşekkür ederim beni çok büyük bir uğraştan kurtardınız....

 

[Necdet]

oldu necdet bey çok teşekkür ederim beni çok büyük bir uğraştan kurtardınız....

Güle güle kullanınız.

koddaki :

Aranan = Array("AİLESİYLE YAŞIYOR", "YALNIZ YAŞIYOR")

satırında aranan sözcükleri değiştirebilir, ekleyebilirsiniz.

 

[fhrsym]

necdet bey sizden çok küçük bişey daha isteyebilir miyim? yazdığınız kodda bulunan hücreler en son sütuna taşınırken taşınan hücreyi silip daha sonra taşıyabilir miyiz?

 

[Necdet]

necdet bey sizden çok küçük bişey daha isteyebilir miyim? yazdığınız kodda bulunan hücreler en son sütuna taşınırken taşınan hücreyi silip daha sonra taşıyabilir miyiz?

Soruyu anlamadım.

 

[fhrsym]

makro, hücre içeriğini aktarırken aktardığı hücreyi silebilir mi? yani örnek dosyada b2 hücresindeki istanbulda yalnız yaşıyor ifadesini d2 hücresine aktarırken b2 hücresininin içeriğini temizleyip ondan sonra d2 hücresine aktarabilir mi?

 

[Necdet]

Merhaba,

Aşağıdaki şekilde deneyiniz.

Sub BulveAktar()
    
    Dim c   As Range, _
        Adr As String, _
        i   As Long, _
        j   As Integer, _
        Aranan
    
    i = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Sayfadaki Son Satır Numarasını Verir
    Aranan = Array("AİLESİYLE YAŞIYOR", "YALNIZ YAŞIYOR")                       'Aranacak sözcükler
    
    Application.ScreenUpdating = False
    On Error Resume Next
    
    Range("D:D").ClearContents
    
    For j = 0 To UBound(Aranan)
    
        With Range("a1:c" & i)
            Set c = .Find(Aranan(j), LookIn:=xlValues)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Range("D" & c.Row) = c.Value
                    Range(c.Address).ClearContents
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    
    Next j
        
End Sub

 

[fhrsym]

Necdet bey d sütununa atıyor ancak ben a sütununa atmak istiyorum,koddaki d'leri a yapıyorum ama hepsini siliyor a sütununa yapıştırmıyor... Bunun sebebi nedir acaba?