Kopyalan yeni satır sarı renk alsın?

[Araştırıcı]

Değerli Forum Üyeleri
Merhaba

Hücreleri çift tıklama yolu ile yukardan aşağıya çoğaltarak kopyalıyorum. Ancak bu en son dolu hücre baz alınarak bir sonraki boş satıra her defasında kopyalama yapılıyor. Amacım son eklenen satırın sarı renk alması. Bu renklendirmeye bir zaman aralığı özelliği verebilir miyiz; mesela 24 saat boyunca sarı kalıp ardından bu satırın dolgusuz eski hale, süre bitiminde dönmesi sağlanabilir mi?

Saygılarımla

 

[Korhan Ayhan]

Selamlar,

Konuyla ilgili örnek dosya eklermisiniz.

 

[girdap]

Sayın Cost Control,
Merhaba.

Araştırıcı için bir örnek hazırlandı, ektedir

Saygılarımızla

 

[Orion1]

Merhaba.
Bir örnekte benden.
Sarı renk için koşullu biçimlendirme uygulandı.

 

[Korhan Ayhan]

Selamlar,

Örnek olarak eklediğiniz dosyada sayfadaki kodu aşağıdaki şekilde değiştirip denermisiniz. Kopyalama işleminden sonra satır sarı renk ile 10 saniye boyunca boyalı kalır. Daha sonra rengi eski halini alır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim s1, s2, s3, s4 As Object
    If Intersect(Target, [D:D,N:N,U:U]) Is Nothing Then Exit Sub
    Cancel = True
    islendimi = Target.Offset(0, 15).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    SON_SATIR = [D65536].End(3).Row + 1
    Rows(ActiveCell.Row).Copy
    Rows(SON_SATIR).Insert Shift:=xlDown
    Application.CutCopyMode = False
    If SON_SATIR <> "" Then: MsgBox "Veri sat&#305;r&#305; yenilenmek &#252;zere en alt sat&#305;ra ta&#351;&#305;nm&#305;&#351;t&#305;r.", vbCritical, "SATIR AKAKTARIMI: Exit Sub"
    SON_SATIR = [D65536].End(3).Row
    Range("A" & SON_SATIR & ":W" & SON_SATIR).Interior.ColorIndex = 6
    Application.Wait Now + TimeValue("00:00:10")
    Range("A" & SON_SATIR & ":W" & SON_SATIR).Interior.ColorIndex = xlNone
    Set s1 = Sheets("potansiyel i&#351;ler")
    If Target.Value = "SP1" Then
    Set s2 = Sheets("SP1")
    sat = s2.[b65536].End(3).Row + 1
    s2.Cells(sat, "b").Value = sat - 1
    s2.Range(s2.Cells(sat, "b"), s2.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s2 = Nothing
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "SP2" Then
    Set s3 = Sheets("SP2")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "SP3" Then
    Set s3 = Sheets("SP3")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "MUTFAK" Then
    Set s3 = Sheets("MUTFAK")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "&#304;HRACAT" Then
    Set s3 = Sheets("&#304;HRACAT")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    islendimi = Target.Offset(0, 15).Value
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "PARAKENDE" Then
    Set s3 = Sheets("PARAKENDE")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "&#214;N TEKLiF" Then
    Set s3 = Sheets("teklif a&#351;amas&#305;ndakiler")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    islendimi = Target.Offset(0, 1).Value
    If islendimi <> "" Then: MsgBox "Bu kay&#305;t daha &#246;nce aktar&#305;lm&#305;&#351;", vbCritical, "M&#220;KERRER KAYIT": Exit Sub
    ElseIf Target.Value = "EV" Then
    Set s3 = Sheets("EV")
    sat = s3.[b65536].End(3).Row + 1
    s3.Cells(sat, "b").Value = sat - 1
    s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "W")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "W")).Value
    Target.Offset(0, 15) = "x"
    Set s3 = Nothing
    Else
    Exit Sub
    End If
    Target.Offset(1, 0).Select
    Set s1 = Nothing
    MsgBox "AKTARIM &#304;&#350;LEM&#304; TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[girdap]

Orion 2
Merhaba Çok pratik ve güzel bir çalışma
Teşekkür ediyoruz.

Ancak meraktan soruyorum, renk sarıdan normale tarihe bağlı olarak kendiliğinden dönecek mi, bunu sağlayacak kod hangisi?

Saygılarımla

 

[Orion1]

Orion 2
Merhaba Çok pratik ve güzel bir çalışma
Teşekkür ediyoruz.

Ancak meraktan soruyorum, renk sarıdan normale tarihe bağlı olarak kendiliğinden dönecek mi, bunu sağlayacak kod hangisi?

Saygılarımla

Merhaba.
E sütununda yazan tarihi bugünün tarihinden değişik bir tarih yazarak Sonucu gözlemleyiniz.

 

[girdap]

Uzmanımız Cost Control'ün cevabını görmedik şimdi farkına vardık.

Size üstat demek gerçekten bizim de hoşumuza gidiyor. Çalışma için teşekkür ediyoruz.

Saygılarımla

 

[girdap]

Sayın Cost Control,

Merhaba bir kez daha.

Renk değişimi harika.
Peki (00:00:00) da ilk sıfır grubu sanırım saati temsil ediyor. Renk değişimi 24 saat boyunca devam etmesi istenirse bu yazımı (24:00:00) olarak mı yazacağız?

Saygılarımla

 

[girdap]

Sayın Orion
size de bir soru sormak istiyorum bu konu ile ilgili.
Tarihi elle değiştirdiğimizde gerçekten işlem tamamlandı. Ancak bir sayaç işlemi kodlarda mevcut mu? Sanırım bu manuel el ile tarih girişi ile çalışacak. Değerli Cost Controlda bir sayaç görebiliyorum ama çalışma yöntemini tam çözemedim. (00:00:00) ilk kısmı 24:00:00 yaparak uyguladığımda hata verdi.

Sizin bu konudaki öneriniz nedir?
Saygılarımızla

 

[Korhan Ayhan]

Selamlar,

Sn. girdap,

Evet doğru yorumlamışsınız.

24 saat boyunca calışması bilgisayarınızı yoracaktır. Ama bu kontrolü yapmak istiyorsanız 23:59:59 şeklinde yazıp deneyin.

 

[Orion1]

Sayın Orion
size de bir soru sormak istiyorum bu konu ile ilgili.
Tarihi elle değiştirdiğimizde gerçekten işlem tamamlandı. Ancak bir sayaç işlemi kodlarda mevcut mu? Sanırım bu manuel el ile tarih girişi ile çalışacak. Sizin bu konudaki öneriniz nedir?
Saygılarımızla

Merhaba tarihi manuel olarak değiştirmenize gerek yok.
Sadece ben size nasıl çalıştığını gözlemlemeniz için söylemiştim.
Oradaki tarihin üzerinden 1 gün geçtikten sonra otomatik olarak hücre renksiz olacaktır.İsterseniz 1 gün deneyiniz.Veya PC'nin tarihini 1 gün ileri alıp deneyebilirsiniz.

 

[girdap]

Çok iyi anladım. Yukarıda değerli Cost Control'ün bahsettiği bilgisyar yorulması sizn yönteminiz için de geçerli mi? Eğer öyle ise sarıya boyanan satırların elle düzeltilmesi yoluna gideceğim.

Teşekkür ediyorum herkese,

Saygılarımla

 

[Orion1]

Çok iyi anladım. Yukarıda değerli Cost Control'ün bahsettiği bilgisyar yorulması sizn yönteminiz için de geçerli mi? Eğer öyle ise sarıya boyanan satırların elle düzeltilmesi yoluna gideceğim.

Teşekkür ediyorum herkese,

Saygılarımla

Merhaba.
Ben koşullu biçimlendirme yöntemini kullandım.
Onun için Bilgisayarın yorulması söz konusu olacağını sanmıyorum.

 

[girdap]

Unutmadan sayın orionun örneğindeki tarih sütunu işin içinde olmak zorunda değil mi? bu sütun aslında gerçek tablomda olamayacak. Böyle bir sütun olmayacak. Bu durumda yordam çalışacak mı?

 

[Orion1]

Unutmadan sayın orionun örneğindeki tarih sütunu işin içinde olmak zorunda değil mi? bu sütun aslında gerçek tablomda olamayacak. Böyle bir sütun olmayacak. Bu durumda yordam çalışacak mı?

Tarihlerin bir yerde tutulması gerekiyor.Yoksa nasıl sorgulama yapılacak?
Eğer tarihlerin gözükmesini istemiyorsanız.O sütunu gizleyebilirsiniz,veya font rengini beyaz olarak ayarlayabilirsiniz.