İki Tarih arasını bul ve işaretle

[usta07]

Form da bu konu çok işlenmesine rağmen maalesef olmadı...
Yapmak istediğim:
Sayfa1 de A sutunda yazılı isimlerin, E Sütun da Başlama F Sütunda bitiş tarihlerini, Sayfa2 de 1. Satırda yazılı tarihlerden bulup A Sütünda yazılı isimlerin karşılığına denk gelen hücrelere 1 yazan kodda hata mesajı alıyorum
Yardımcı olabilecek arkadaşlara teşekkür ederim.

Hata mesajı aldığım satır kırmızı ile işaretli.

Sub biryaz()

For t = 2 To Sayfa1.[E65536].End(3).Row

atarih = CDate(Sayfa1.Cells(t, "E"))
btarih = CDate(Sayfa1.Cells(t, "F"))

Set isim = Sayfa2.Columns(1).Find(Sayfa1.Cells(t, "i"), LookAt:=xlWhole)
Set bulatarih = Sayfa2.Range("B1:GC41").Find(CDate(atarih), LookAt:=xlWhole)
Set bulbtarih = Sayfa2.Range("B1:GC41").Find(CDate(btarih), LookAt:=xlWhole)

[COLOR="Red"]Range(Sayfa2.Cells(isim.Row, bulatarih.Column), Sayfa2.Cells(isim.Row, bulbtarih.Column)).Value = 1[/COLOR]
Set isim = Nothing
Set bulatarih = Nothing
Set bulbtarih = Nothing
Next
End Sub

 

[leumruk]

Merhaba,
Aradığı verilerden birini bulamadığında bu hatayı veriyor. Kodlarınıza bir kontrol satırı ekledim.

Sub biryaz()
For t = 2 To Sayfa1.[E65536].End(3).Row
atarih = CDate(Sayfa1.Cells(t, "E"))
btarih = CDate(Sayfa1.Cells(t, "F"))
Set isim = Sayfa2.Columns(1).Find(Sayfa1.Cells(t, "i"), LookAt:=xlWhole)
Set bulatarih = Sayfa2.Range("B1:GC41").Find(CDate(atarih), LookAt:=xlWhole)
Set bulbtarih = Sayfa2.Range("B1:GC41").Find(CDate(btarih), LookAt:=xlWhole)
[COLOR="Navy"]If Not isim Is Nothing And Not bulatarih Is Nothing And Not bulbtarih Is Nothing Then
Range(Sayfa2.Cells(isim.Row, bulatarih.Column), Sayfa2.Cells(isim.Row, bulbtarih.Column)).Value = 1
End If[/COLOR]
Set isim = Nothing
Set bulatarih = Nothing
Set bulbtarih = Nothing
Next
End Sub

 

[halit3]

Alternatif olsun

Sub aktar()
Worksheets("Sayfa2").Range("B2:GC65000").ClearContents
For s = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(s, 1).Value
If IsDate(Sheets("Sayfa1").Cells(s, "e").Value) = True Then
If IsDate(Sheets("Sayfa1").Cells(s, "f").Value) = True Then
For r = 2 To Worksheets("Sayfa2").Cells(Rows.Count, "a").End(3).Row
aranan2 = Sheets("Sayfa[COLOR=red]2[/COLOR]").Cells(r, 1).Value
If aranan1 = aranan2 Then
Tarih1 = CDate(Sheets("Sayfa1").Cells(s, "e").Value)
Tarih2 = CDate(Sheets("Sayfa1").Cells(s, "f").Value)
For j = 0 To Val(Tarih2 - Tarih1)
aranan3 = Tarih1 + j
For n = 2 To Worksheets("Sayfa2").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If aranan3 = Sheets("Sayfa2").Cells(1, n).Value Then
Sheets("Sayfa2").Cells(r, n).Value = 1
[COLOR=red]Exit For[/COLOR]
End If
Next n
Next j
[COLOR=red]Exit For[/COLOR]
End If
Next r
End If
End If
Next s
MsgBox "işlem tamam"
End Sub

 

[halit3]

üç nolu mesajdaki kodun hızlı çalışması için kırmızı yerleri ekledim.

 

[usta07]

Sayın Mustafa Altun,
Sayın Halit Özdemir,
Çok teşekkür ederim. Sağolun varolun Allah ilminizi artırsın.

 

[usta07]

Sayın Halit ÖZDEMİR,
3. mesajda yazmış olduğunuz kod çalışıyor ancak bu gün dikkatlice kontrol ettiğimde bir sorun olduğunu gördüm. Sayfa1 deki tarihlerin karşılığını sayfa2 de buluyor ancak sayfa1 deki isimleri sayfa2 deki isimlerle eşleştirmeden sıradan yazıyor. örneğin sayfa1 deki E isim karşılığını sayfa2 de A isim karşılığına yazıyor bu soruna müsait olduğunuzda bakabilir misiniz. İlgilerinize şimdiden teşekkür ederim.

 

[halit3]

Sayın Halit ÖZDEMİR,
3. mesajda yazmış olduğunuz kod çalışıyor ancak bu gün dikkatlice kontrol ettiğimde bir sorun olduğunu gördüm. Sayfa1 deki tarihlerin karşılığını sayfa2 de buluyor ancak sayfa1 deki isimleri sayfa2 deki isimlerle eşleştirmeden sıradan yazıyor. örneğin sayfa1 deki E isim karşılığını sayfa2 de A isim karşılığına yazıyor bu soruna müsait olduğunuzda bakabilir misiniz. İlgilerinize şimdiden teşekkür ederim.

Sayfa1 deki E isim karşılığını Sayfa2 deki AI6 dan AU6 ya kadar verileri aktarıyor yani sizin dediğiniz gibi a isim karşılığına aktarmıyor.

Herhalde sizin gönderdiğiniz dosya ile kodu uyguladığınız dosya arasında farklılıktan olabileceğini düşünüyorum.

Hata aldığınız dosyayı yazmış olduğum kodla birlikte ekleyiniz bakalım.

 

[halit3]

Tamam anladım sorunu 3 nolu mesajdaki kırmızı gösterilen yeri düzelttim.

yanlış olan kod

aranan2 = Sheets("Sayfa[COLOR=red]1[/COLOR]").Cells(r, 1).Value

doğru olan kod

aranan2 = Sheets("Sayfa[COLOR=red]2[/COLOR]").Cells(r, 1).Value

 

[usta07]

doğru olan kod

aranan2 = Sheets("Sayfa[COLOR=red]2[/COLOR]").Cells(r, 1).Value

[/QUOTE]

Şimdi Düzeldi Çok Teşekkür ederim.

 

[halit3]

doğru olan kod

aranan2 = Sheets("Sayfa[COLOR=red]2[/COLOR]").Cells(r, 1).Value

Şimdi Düzeldi Çok Teşekkür ederim.[/quote]

İyi çalışmalar