Veri Ara Bul

1 2 3 4
06/04/2020, 00:40

yyhy

Sayın feraz ilgili macroyu deneyip bilgi vereyim.
06/04/2020, 00:44

feraz

Tamam.Biliyorsununuz diye aktif hücre için şart koymadım yani if activecell.address(0,0)= "B2" then gibi yada intersect yöntemini felanda uygulayabilirsiniz.
06/04/2020, 00:48

yyhy

Kriter bölümü baştan sonuna kadar kullanılabilir. Kodu denedim ama istediğim gibi bir sonuç vermedi.
İlk eklediğim dosyada arama yaparken içerir olarak düzeltebilsek çok iyi olacak. Şimdi ben B2:F2 aralığını kriter olarak yaptım bazen 1 hücreyi bazen de tamamına veri yazmak suretiyle arattırıyorum. Örneğin resmideki gibi. Resimde 1 isim arattırmışım ama * karakteri hem başına hem sonuna koydum. Kullanıcılar * işareti koymadan kullansın istiyorum.
06/04/2020, 13:19

feraz

Benim bildiğim gelişmiş olayı için kod kalıbı ayıdır.Resimde yaten istanbul geçenler bulunmuş.Allaki kodu deneyin birde.*a*a olarak aranmalı içerik olarak.

Kod:
Sub Makro1()

        Sheets("Ara").Range("B5:F" & Rows.Count).Clear
      Sheets("Veri").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Ara").Range("B1:F2"), CopyToRange:=Sheets("Ara").Range("B5:F5"), Unique:=False
      Sheets("Ara").Range("F3").Select

End Sub
08/04/2020, 12:47

yyhy

Sayın farez bey macroyu şu şekilde hallettim örnek dosyayı da buraya ekliyorum.

Sub Ara()
    Dim i As Byte
    For i = 2 To 6
        Cells(2, i).ClearContents
        If Cells(3, i) <> "" Then
            Cells(2, i) = "*" & Cells(3, i) & "*"
        End If
    Next i
    On Error Resume Next
    Range("B5").Select
    Selection.CurrentRegion.Select
    Selection.Clear
    Range("B5").Select
    Sheets("Veri").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("B1:F2"), CopyToRange:=Range("B5"), Unique:=False
    Range("F3").Select
End Sub
16/04/2020, 21:37

yyhy

Cevaplanmış soruların içerisine taşıyabilirsiniz. Konuyu son örnekteki gibi çözüme kavuştu. Teşekkürler.
1 2 3 4