06/04/2020, 00:40
06/04/2020, 00:44
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
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.
İ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
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 Sub08/04/2020, 12:47
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
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
Cevaplanmış soruların içerisine taşıyabilirsiniz. Konuyu son örnekteki gibi çözüme kavuştu. Teşekkürler.