(12/11/2009, 02:03)maytas yazdı: Merhaba.
Sayın axikral, alttaki kodları bir deneyin bakalım sitediğinize cevap verecek mi.
PERSONEL PERFORMANS sayfasında B4 hücresine yazdığınız tarihi D4:AH4 aralığında arıyor ve bulunca alttaki 6 satıra B4 hücresinin aştındaki 6 satırı değerlerini ekliyor.
Yanılmıyorsam istediğiniz buydu.
Kodları bir butona atayın ve hergün yeni değerleri girdiğinizde düğmeye tıklamanız yeterli olacak.
Kod:
Sub Aktar()
Dim Alan As Range, Hucre As Range, Gunun_Tarihi As Range, Tarih As Date, Satir As Integer
With Worksheets("PERSONEL PERFORMANS")
Set Gunun_Tarihi = .Range("B4")
Tarih = DateSerial(Year(Gunun_Tarihi), Month(Gunun_Tarihi), Day(Gunun_Tarihi))
Set Alan = .Range("D4:AH4")
For Each Hucre In Alan.Cells
If CDate(Hucre.Value) = Tarih Then
For Satir = 1 To 6
Hucre(1 + Satir, 1) = Hucre(1 + Satir, 1) + Gunun_Tarihi(1 + Satir, 1)
Next
Exit For
End If
Next
End With
End Sub
Bence çok başarılı bir kod. Elinize sağlık maytas.
Teşekkürler, nihatkr.
Umarım soruyu soran arkadaşın aradığı cevap budur, gerçi henüz dönmedi ama.
O cevabı almış artık dönmez. Birdaha ihtiyaç olursa ozaman döner.
Merhaba.
Siz der takdir edersiniz ki bu tür forumlarda forum müdavimleri hiç bir maddi karşılık beklemeden sadece kişinin işi görülsün diye kendi zamanından feragat ederek, hatta belki de ailesine ayıracağı bu zamandan feragat ederek genellikle hiç tanımadığı ve görmediği kişiye yardıma koşmaktadır.
Bunun karşılığında en azından bit teşekkür, ve ya tamam işim görüldü türünde bir mesaj beklemesini çok görmeyiniz lütfen.
Yaklaşık 10 yıldır forumlardayım. Cevabını alıp ta bir teşekkürü ve ya tamam işim halloldu diye 2 kelime yazmaya tenezzül etmeyen o kadar çok üye gördüm ki.
Dolayısıyla sayın nihatkr genel olarak haksız sayılmaz.
Bu mesajın amacı sizi kişisel olarak eleştirmekten ziyade üstte sözünü ettiğim davranışlara(buna vefasızlık ta diyebilirsiniz) bir sitem olarak görüyorum.
Hatta örneğin siz bile şimdi işinizin görülüp görülmediğini belirtmemişsiniz.
(12/11/2009, 04:16)nihatkr yazdı: (12/11/2009, 02:03)maytas yazdı: Merhaba.
Sayın axikral, alttaki kodları bir deneyin bakalım sitediğinize cevap verecek mi.
PERSONEL PERFORMANS sayfasında B4 hücresine yazdığınız tarihi D4:AH4 aralığında arıyor ve bulunca alttaki 6 satıra B4 hücresinin aştındaki 6 satırı değerlerini ekliyor.
Yanılmıyorsam istediğiniz buydu.
Kodları bir butona atayın ve hergün yeni değerleri girdiğinizde düğmeye tıklamanız yeterli olacak.
Kod:
Sub Aktar()
Dim Alan As Range, Hucre As Range, Gunun_Tarihi As Range, Tarih As Date, Satir As Integer
With Worksheets("PERSONEL PERFORMANS")
Set Gunun_Tarihi = .Range("B4")
Tarih = DateSerial(Year(Gunun_Tarihi), Month(Gunun_Tarihi), Day(Gunun_Tarihi))
Set Alan = .Range("D4:AH4")
For Each Hucre In Alan.Cells
If CDate(Hucre.Value) = Tarih Then
For Satir = 1 To 6
Hucre(1 + Satir, 1) = Hucre(1 + Satir, 1) + Gunun_Tarihi(1 + Satir, 1)
Next
Exit For
End If
Next
End With
End Sub
Bence çok başarılı bir kod. Elinize sağlık maytas.
Paylaşımınız için teşekkürler SAnırım bir yerde yanlış yapıyorum Düğmeye bu değerleri girdiğmide aynı kayıt gününde (14.11.2009 tarihine 14.11.20092 yazıyor) tarihin son kısmına 2,3.4, gibi sayılar ekliyor.