Makro İle Son Girilen Devam Etsin

[ormann]

İyi günler ;
ekli örnek dosyada G15:G5000 hücre aralığına herhangi bir rakam girdiğim zaman F15:F5000 hücre aralığındaki en son satırda girdiğim veri hangisi ise G15:G5000 hücre aralığında işlem yaparsam F sütündai karşılığına aynı veriyi yazmaya otomatik olarak yazmasını istiyorum.Yardımcı olur musunz?


http://dosya.co/vv1oknieo7kv/Örnek.xls.html

 

[Ömer BARAN]

Merhaba.

Alt taraftan, işlem yapılacak sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki BOŞ alana aşağıdaki kod'u yapıştırın.

Kod'da;
-- siyah renkli satırlar istediğiniz işlemi yapar,
-- kırmızı renklendirdiğim kısım ise, G sütununda daha evvel yazılmış bir veri silindiğinde, aynı satır F sütunundaki veriyi de siler.

Silme işlemini istemiyorsanız, kırmızı renklendirdiğim kısmı silerek kullanın.
.

[B][COLOR="blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Target.Row > 14 And Target.Column = 7 And Target <> "" Then _
    Cells(Target.Row, 6) = Cells(Cells(Rows.Count, 6).End(3).Row, 6)
[COLOR="Red"]If Target.Row > 14 And Target.Column = 7 And Target = "" Then _
    Cells(Target.Row, 6) = ""[/COLOR]
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[ormann]

Ömer bey teşekkür ederim.

 

[ormann]

Ömer bey şu kodu ,yapmış olduğunuz koda nasıl ilave ederiz.

If Intersect(Target, [ID4]) Is Nothing Then Exit Sub
Call Module1.tarih_ekle

 

[ormann]

Ömer bey asıl dosyama yükleme yapamadım.Dikili girişi sayfasına aynı kodu yapar mısınız .

http://dosya.co/r9177c029miz/DİKİLİ_PROGRAMI_(110).xlsm.html

 

[Ömer BARAN]

G'yi silince F'nin de silinmesini isteyip istemediğinizi bilemiyorum.
Silme işlemini istemiyorsanız kırmızı kısmı silerek kullanın.
.

[B][COLOR="Blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Target.Row > 14 And Target.Column = 7 And Target <> "" Then
    Cells(Target.Row, 6) = Cells(Cells(Rows.Count, 6).End(3).Row, 6)
    Exit Sub
[COLOR="Red"]ElseIf Target.Row > 14 And Target.Column = 7 And Target = "" Then _
    Cells(Target.Row, 6) = ""
    Exit Sub[/COLOR]
End If

If Intersect(Target, [ID4]) Is Nothing Then Exit Sub
Call Module1.tarih_ekle
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[ormann]

Ömer bey asıl dosyamda devamlı Kn yazdığım halde Kayın yazıyor.Aynı Şekilde Gn yazıyorum Yine Kayın yazıyor

 

[Ömer BARAN]

Alt tarafta bir hücrede Kayın kelimesinin yazılı olduğu bir hücre vardır.
İsteğinizi netleştirmemenizden kaynaklanan bir durum.

Verdiğim kod, F sütunu son satırdan (F65536) yukarı doğru ilk dolu hücredeki veriyi yazacak şekilde hazırlandı.

Yok eğer, en son hücreden değil, aktif hücrenin satırından yukarı doğru ilk dolu hücredeki değer
isteniyorsa ilgili kod satırındaki Rows.Count ibaresini Target.Row olarak değiştirin.
.

 

[ormann]

Ömer bey şu kod hata veriyor

If Target.Row > 14 And Target.Column = 7 And Target <> "" Then

 

[ormann]

ID4 hücresine çift tıkladığımda tarih açılıyor.Bu tarihi seçtiğimde hata veriyor.

http://dosya.co/zgnkccv2mhi3/DİKİLİ_PROGRAMI_(6).xlsm.html

 

[Ömer BARAN]

Benim bilgisayarımda Calender çalıştıramadığımdan deneme şansım yok.

Çözüm olarak şunu önereyim.
-- Dikili Girişi sayfasına ait mevcut kodu silip yerine aşağıdakini yapıştırın (tarih_ekle makrosunu sayfa kodlarının içerisine ekledim).
-- Module1'deki tarih_ekle makrosunu silin.
.

[B][COLOR="Blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Intersect(Target, Range("ID4:G" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Row > 14 And Target.Column = 7 And Target <> "" Then
    Cells(Target.Row, 6) = Cells(Cells(Target.Row, 6).End(3).Row, 6)
    Exit Sub
ElseIf Target.Row > 14 And Target.Column = 7 And Target = "" Then _
    Cells(Target.Row, 6) = ""
    Exit Sub
ElseIf Target.Address(0, 0) = "ID4" Then
    SonSatir = Cells(65536, "G").End(xlUp).Row
        For i = 15 To SonSatir
            If Cells(i, "G") <> Empty Then
                Cells(i, "D") = CDate([ID4])
            End If
        Next
End If
[B][COLOR="blue"]End Sub[/COLOR][/B]

 

[ormann]

Ömer bey çalışmadı

 

[ÖmerBey]

Merhaba,
Ömer Bey'in anlayışına sığınarak konuya dahil olayım. ID4 birleştirilmiş hücre olduğu için hata alıyorsunuz. Birleştirmeyi iptal edip hücre genişlik ayarıyla ilgili alanın büyümesini sağlayabilirsiniz.
İyi çalışmlar...

 

[ormann]

Ömer bey kod çalıştı.Fakat en son girilen veri devam etmiyor.Tarihte ki sıkıntı düzeldi.Ama en son girilen veri devam etmiyor.

 

[ormann]

Örnek dosyada F93 hücresine Kn yazıp g93 veri girdiğimde Kn yazması gerekirken F14 hücresindeki veriyi yazıyor.
http://dosya.co/3qub5nht9sce/Örnek.xls.html

 

[Ömer BARAN]

Cells(Target.Row, 6) = Cells(Cells(Target.Row[B][COLOR="Red"] + 1[/COLOR][/B], 6).End(3).Row, 6)