Hücre dolu ise Tarihler Atma + otomatik sayi arttırma

O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
İyi günler üstadlar

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim s As Long
If Intersect(Target, Range("C5:C65536")) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy")
If Target.Value = "" Then
Target.Offset(0, 1) = ""
End If
End Sub

Formülü ile C5 hücresinden itibaren veri girişinde D5 hücresine tarih atıp C5 teki veriyi silince D5 deki tarih de siliniyor ama benim istediğim
1- C5 hücresine veri girince D5 ile birlikte F5 ve J5 hücresine de kod ile tarih atsın C5 silinince silinsin (F5=D5 ve J5=D5 formülü ile istemiyorum)
2- C5 hücresine veri girince E5, G5, M5 ve N5 hücrelerine “-“ (tire) “_” (alt çizgi de olabilir) kod ile yazsın istiyorum.
3- Birde eğer olur ise C5 hücresine veri girince B5 hücresinde 1 den başlamak üzere 1 er artan 1, 2, 3 … ) sayı verilebilirmi?

Şimdiden ilgilenenlere teşekkür ederim
 
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

If Intersect(Target, Range("C5:C" & Rows.Count)) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 3) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 7) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, -1) = Target.Row - 4
Target.Offset(0, 2) = "-"
Target.Offset(0, 4) = "-"
Target.Offset(0, 10) = "-"
Target.Offset(0, 11) = "-"

If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 7) = ""
Target.Offset(0, 2) = ""
Target.Offset(0, 4) = ""
Target.Offset(0, 10) = ""
Target.Offset(0, 11) = ""

End If
End Sub
Buyrun..
 
O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
Allah razı olsun çok güzel olmuş
 
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Sizden de inşallah.
Hayırlı çalışmalar..
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.
Bir uyarıda bulunmak istedim.
Hücrelere yazılan değerler tarih gibi görünse de tarih DEĞİL.
Filtre uygulayıp, filtreden ay/yıl/gün seçmeyi denerseniz görebilirsiniz.
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Sayın acar'ın verdiği koda aşağıdaki mavi satırı ekleyip,
kırmızı renklendirdiğim kısımları (3 adet satırdaki) ilgili satırlardan silerek istediğiniz sonuca ulaşılabilir.
Kod: 
[FONT="Trebuchet MS"]If Intersect(Target, Range("C5:C" & Rows.Count)) Is Nothing Then Exit Sub
[COLOR="Blue"]Range(Cells(Target.Row, 4), Cells(Target.Row, 10)).NumberFormat = "dd.mm.yyyy"[/COLOR]
Target.Offset(0, 1) =[COLOR="Red"]Format([/COLOR]Now[COLOR="red"], "dd.mm.yyyy")[/COLOR][/FONT]
 
O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
Sayın; acar6783 ve Ömer BARAN çok teşekür ederim.
çok güzel oldu ancak büroda bazı arkadaşlar excele veri girişi yaptıktan sonra kayıt etmeden çıkış yapıp kayıt sorusuna da Hayır diyebiliyorlar.

Kayıt sorununu çözmek üzere bu kodlara ek L5:L65536 hücrelerine gelindiğinde (tab, yön tuşları ya da maus ile) ve bu hücreden çıkıldığında (tab, yön tuşları, enter yada maus ile) otomatik kayıt kodu eklenebilirmi ? :) :mutlu:
 
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
obas73' Alıntı:
Sayın; acar6783 ve Ömer BARAN çok teşekür ederim.
çok güzel oldu ancak büroda bazı arkadaşlar excele veri girişi yaptıktan sonra kayıt etmeden çıkış yapıp kayıt sorusuna da Hayır diyebiliyorlar.

Kayıt sorununu çözmek üzere bu kodlara ek L5:L65536 hücrelerine gelindiğinde (tab, yön tuşları ya da maus ile) ve bu hücreden çıkıldığında (tab, yön tuşları, enter yada maus ile) otomatik kayıt kodu eklenebilirmi ? :) :mutlu:
Genişletmek için tıkla ...

kodlarınızın sonuna:

Kod: 
ActiveWorkbook.Save
Ekleyin.
Dosyanın boyutuna göre yavaşlatabilir.
Her işlemden sonra kaydeder

Bir diğer öneri ise;

Workbook kod bölümüne;

Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Save
End Sub

Her çıkış yaptığınızda kayeder.
 
O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
L stünu'ndaki bir hücreye giriş ya da çıkışta veya veri girişi yapıldığı anda kayıt imkanı yok mudur acaba ?
 
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
obas73' Alıntı:
L stünu'ndaki bir hücreye giriş ya da çıkışta veya veri girişi yapıldığı anda kayıt imkanı yok mudur acaba ?
Genişletmek için tıkla ...

Imkan var ama gerek varmı?
Çıkarken kaydetsin daha iyi gibi
 
O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
Girilen verileri silip nasılsa çıkarken kaydedil sinmi diye soracak hayır derim düşünce siyle hareket eden olursa diye endişem var sayın acar6783
 
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Denediniz mi?
Kodları girdikten sonra zaten sormadan kaydeder.

acar6783' Alıntı:
kodlarınızın sonuna:

Kod: 
ActiveWorkbook.Save
Ekleyin.
Dosyanın boyutuna göre yavaşlatabilir.
Her işlemden sonra kaydeder

Bir diğer öneri ise;

Workbook kod bölümüne;

Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Save
End Sub

Her çıkış yaptığınızda kayeder.
Genişletmek için tıkla ...
 
O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
L stünuna göre mümkün ise o şekilde daha iyi olacaktır.
 
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c5:c65536,l5:l65536]) Is Nothing Then Exit Sub
If Target.Column = 12 Then ActiveWorkbook.Save
If Intersect(Target, Range("C5:C" & Rows.Count)) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 3) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 7) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, -1) = Target.Row - 4
Target.Offset(0, 2) = "-"
Target.Offset(0, 4) = "-"
Target.Offset(0, 10) = "-"
Target.Offset(0, 11) = "-"

If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 7) = ""
Target.Offset(0, 2) = ""
Target.Offset(0, 4) = ""
Target.Offset(0, 10) = ""
Target.Offset(0, 11) = ""

End If

End Sub
Buyrun...
 
O

obas73

Katılım
14 Kasım 2008
Mesajlar
10
Excel Vers. ve Dili
2013 - Türkçe
Allah Razı Olsun Sayın acar6783
L stünundan çıkışta kayıt yapıyor. Çok güzel olmuş
bende bu işlemden sonra Kaydedildi diye mesaj versin dedim ama C sütununa veri girişi yapınca da aynı mesajı veriyor.

Sadece L sütunu ndan sonra mesaj vermesini sağlayıp gelen bu mesaja Tamam deyince C stünunda en son boş hücreye gitmesi ve C5 ten N5 e tüm sütun ve satırlara yani "C5:N65536" veri girişlerini büyük harfe çevirebilirmi?

Her şey için çok teşekkür ederim. Elleriniz dert görmesin

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [C5:C65536,L5:L65536]) Is Nothing Then Exit Sub
If Target.Column = 12 Then ActiveWorkbook.Save
MsgBox ("Kaydedildi")
If Intersect(Target, Range("C5:C" & Rows.Count)) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 4), Cells(Target.Row, 10)).NumberFormat = "dd.mm.yyyy"
Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 3) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 7) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, -1) = Target.Row - 4
Target.Offset(0, 2) = "-"
Target.Offset(0, 4) = "-"
Target.Offset(0, 10) = "-"
Target.Offset(0, 11) = "-"

If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 7) = ""
Target.Offset(0, 2) = ""
Target.Offset(0, 4) = ""
Target.Offset(0, 10) = ""
Target.Offset(0, 11) = ""

End If

End Sub
 
Son düzenleme:
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Excelde yapılmayacak iş yok :)
Buyrun.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c5:c65536,l5:l65536]) Is Nothing Then Exit Sub
If Target.Column = 12 Then ActiveWorkbook.Save: MsgBox "Kayıt Yapıldı": Range("C" & Cells(Rows.Count, "C").End(3).Row + 1).Select
If Intersect(Target, Range("C5:C" & Rows.Count)) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 3) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 7) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, -1) = Target.Row - 4
Target.Offset(0, 2) = "-"
Target.Offset(0, 4) = "-"
Target.Offset(0, 10) = "-"
Target.Offset(0, 11) = "-"

If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 7) = ""
Target.Offset(0, 2) = ""
Target.Offset(0, 4) = ""
Target.Offset(0, 10) = ""
Target.Offset(0, 11) = ""

End If

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst