Sayfa 2 deki isimlerin karşısına değeri yazma

[evren_01]

Arkadaşlar bu makroda yardımlarını beliyorum
Burada yapmak istediğim
sayfa 1 de B14:b44 arasında isimlerin karşısında bulunan d14:d44 arasında ise saatleri
Sayfa 2 deki isimlerin karşındaki kutulara değeri yazmasını istiyorum
Sorun şu Sayfa 2 deki a2:a11 asındaki kişileri yazıyor sonra siliyor.

:dua:
Sub çizelge()
Dim tarih As String
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = Sheets("sayfa2").Range("a65536").End(xlUp).Row
Set tarihalani = Sheets("sayfa2").Range("c1:ag1")
Set isimalani = Sheets("sayfa2").Range("a3:a" & son + 15)
tarih = Sheets("sayfa1").Range("A1").Value

For i = 13 To son
isim = Sheets("sayfa1").Range("B" & i).Value
Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
End If
Next i
'Range("A1").Select

End Sub
:kafa:

 

[uzaylı]

Merhaba,

Kodlarınızı bir kaç ufak değişiklikle çalıştırdım ve bir sorunla karşılaşmadım.

Sub çizelge()
    Dim Tarih
    Dim isim As String
    Dim Son As Integer
    Dim satir, sutun, i
    Dim tarihalani As Range, isimalani As Range, tarih1 As Range, isim1 As Range

    On Error Resume Next
    
    Son = Sheets("sayfa2").Range("a65536").End(xlUp).Row
    Set tarihalani = Sheets("sayfa2").Range("c1:ag1")
    Set isimalani = Sheets("sayfa2").Range("a3:a" & Son + 15)
    Tarih = Sheets("sayfa1").Range("A1").Value

    For i = 13 To Sheets("sayfa1").Range("b65536").End(xlUp).Row
        isim = Sheets("sayfa1").Range("B" & i).Value
        Set tarih1 = tarihalani.Find(Tarih, lookat:=xlWhole)
        Set isim1 = isimalani.Find(isim)
        
        If tarih1 Is Nothing Then
            MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
            Exit Sub
        Else
            sutun = tarih1.Column
            satir = isim1.Row
            Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
        End If
    Next i
End Sub

Bu kodları bir denermisiniz?

 

[evren_01]

:kafa: dostum ilginize teşekkür ederim
yanlız aradığınız isim ve tarih bulunamadı diyor

 

[uzaylı]

Merhaba,

Kod bende çalışıyor. Yani Sayfa1 in A1 hücresindeki değeri Sayfa2 nin C1:AG1 aralığında arıyor varsa buluyor.

Eğer sizin sayfanız da bu şekilde ve tarih değeri C1:AG1 aralığında var ise bulması gerekir. Muhtemelen bir Format sorunu olabilir. Bu aralıkların ve A1 hücresinin tarih formatında olması gerekir. Ve sizin ilk kodunuzda ki gibi

Dim Tarih As String

değilde

Dim Tarih

şeklinde tanımlanması gerekir.

Bu hususlara dikkat ederseniz çalışması gerekir.

Kolay gelsin

 

[evren_01]

Dostum
Benim size verdiğim makrp güzel çalışıyor yanlız küçük bir sorun var sayfa 2 de kişilerin yanına rakamları yazıyor sonra bunları siliyor bunu engellemek istiyorum . umarım acıklayıcı olmuşumdur

 

[uzaylı]

Merhaba,

Sizin kodlarınızda verileri silen bir kod göremedim. Eğer dosyanızı bana gönderebilirseniz yardımcı olmaya çalışırım.

Not: Ã?zel mesajlarınıza bakınız...

 

[evren_01]

Hüseyin beye ve Uzaylıya sorunun çözümünde yardımcı olduklarından dolayı teşekkür ederim. :hihoho:

Sub çizelge()
Dim tarih As Date
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = Sheets("sayfa1").Range("B65536").End(xlUp).Row 'sayfa1 ve B65536 olarak değiştirdim.
Set tarihalani = Sheets("sayfa2").Range("d1:ah1")
Set isimalani = Sheets("sayfa2").Range("a3:a53")
tarih = Sheets("sayfa1").Range("B11").Value

For i = 17 To son
isim = Sheets("sayfa1").Range("B" & i).Value
Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
    Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
End If
Next i
'Range("A1").Select

End Sub