sayfalarda arama yapmak.

[mavidus]

arkadaşlar çalışmamda bulunan sayfa1 , 2 , 3 , 4 te bulunan veriler arasında arama yapıp bulunanları sayfa 5'e aktarmak istiyorum.Ã?rneğimi ekledim,yardımcı olursanız sevinirim.şimdiden herkese çok teşekkürler.

 

[mavidus]

arkadaşlar yardım edebilecek kimse yokmu.?

 

[Levent Menteşoğlu]

Bugüne göre süzme için;

[vb:1:662a0a186b]Private Sub CommandButton1_Click()
[a2:e65536].ClearContents
For a = 1 To 4
Set s1 = Sheets(a)
For b = 2 To s1.[a65536].End(3).Row
If s1.Cells(b, 6) <> 0 Then GoTo 10
If s1.Cells(b, 1) = Date Then
say = [a65536].End(3).Row + 1
For c = 1 To 5
Cells(say, c) = s1.Cells(b, c).Value
Next
End If
10 Next
Next
End Sub[/vb:1:662a0a186b]

Bu haftaya göre süzme için;

[vb:1:662a0a186b]Private Sub CommandButton2_Click()
[a2:e65536].ClearContents
For a = 1 To 4
Set s1 = Sheets(a)
For b = 2 To s1.[a65536].End(3).Row
If s1.Cells(b, 6) <> 0 Then GoTo 10
bugun = WorksheetFunction.Weekday(Date, 2)
ilkgun = 1 - bugun + Date
songun = 7 - bugun + Date
If s1.Cells(b, 1) >= ilkgun And s1.Cells(b, 1) <= songun Then
say = [a65536].End(3).Row + 1
For c = 1 To 5
Cells(say, c) = s1.Cells(b, c).Value
Next
End If
10 Next
Next
End Sub[/vb:1:662a0a186b]

Bu aya göre süzme için;

[vb:1:662a0a186b]Private Sub CommandButton3_Click()
[a2:e65536].ClearContents
For a = 1 To 4
Set s1 = Sheets(a)
For b = 2 To s1.[a65536].End(3).Row
If s1.Cells(b, 6) <> 0 Then GoTo 10
If Month(s1.Cells(b, 1)) = Month(Date) Then
say = [a65536].End(3).Row + 1
For c = 1 To 5
Cells(say, c) = s1.Cells(b, c).Value
Next
End If
10 Next
Next
End Sub
[/vb:1:662a0a186b]

 

[mavidus]

syn leventm çok sağolasın ellerin dert görmesin harika olmuş....

 

[mavidus]

syn leventm bir sorum olacaktı bu konu hakkında, bu aramayı genel olarak değilde sadece sayfa 1 gibi yada istediğimiz 3 sayfada aratıp diğer sayfalarda artmama gibi şansımız varmı acaba.?

 

[danersin]

sadece bir sayfada arama yapmak için aşağıdaki gibi;

Private Sub CommandButton3_Click()
[a2:e65536].ClearContents
Set s1 = Sheets("aramayapilacaksayfaninisminiyaz")
For b = 2 To s1.[a65536].End(3).Row
If s1.Cells(b, 6) <> 0 Then GoTo 10
If Month(s1.Cells(b, 1)) = Month(Date) Then
say = [a65536].End(3).Row + 1
For c = 1 To 5
Cells(say, c) = s1.Cells(b, c).Value
Next
End If
10 Next
End Sub

yada 1 ile 4 arasında sayfa indisi yerine 1 ile 2 arası indisi olan sayfalarda araması için a nın değerini değiştirin;

Private Sub CommandButton3_Click()
[a2:e65536].ClearContents
for a=1 to 2
Set s1 = Sheets(a)
For b = 2 To s1.[a65536].End(3).Row
If s1.Cells(b, 6) <> 0 Then GoTo 10
If Month(s1.Cells(b, 1)) = Month(Date) Then
say = [a65536].End(3).Row + 1
For c = 1 To 5
Cells(say, c) = s1.Cells(b, c).Value
Next
End If
10 Next
next
End Sub

 

[mavidus]

syn leventm dikkatimi çeken bir şey oldu bu kodları yeni bir çalışma kitabı oluşturduğumuzda ve kodları eklediğimde çalışıyor ama bende var olan çalışma kitabı kitabına eklediğimde çalışmıyor.Bedeki tüm sayfaları silip yeniden sayfalar eklediğimde çalışıyor.İlginç bir durum acaba nerede hata yapıyor olabilirim.