(11/10/2022, 15:11)berduş yazdı: dosyayı rar yada zip olarak sıkıştırıp öyle ekleyemeyi dener misiniz

(11/10/2022, 16:38)dd2708 yazdı:

(11/10/2022, 15:11)berduş yazdı: dosyayı rar yada zip olarak sıkıştırıp öyle ekleyemeyi dener misiniz

EKLEDIM

1 - dosyanız makro çalıştırabilen dosya formatında olmalı (xlsm, xlsb,xls gibi)
2 - alt + F11 ile ilgili sayfanın Vba sayfasını açın
3 - aşağıdaki kodları yapıştırın
modülün en başına hücrenin ilk değerini kaydeden değişken tanımı eklenir

Dim EskiDgr

hücreye odaklanıldığında hücrenin değeri aşağıdaki kod ile hafızaya alınır böylece içerik değiştiğinde eski veriye ulaşılabilir

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    EskiDgr = Target.Value

End Sub

içerik değiştiğinde eski değerin yeri bulunup yan gücredeki değer alınır
yeni değerin yeri bulunup veri oraya taşınır

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A:A")) Is Nothing Then

YeniDgr = Target.Value

    Set AramaE = Range("D").Find(what:=EskiDgr, LookIn:=xlValues, lookat:=xlWhole)

    Set AramaY = Range("D").Find(what:=YeniDgr, LookIn:=xlValues, lookat:=xlWhole)

    If Not AramaE Is Nothing Then If Not AramaY Is Nothing Then _

                xDgr = AramaE.Offset(, 1).Value: AramaY.Offset(, 1).Value = xDgr: AramaE.Offset(, 1).Value = ""

End If

End Sub

(11/10/2022, 20:40)berduş yazdı: 1 - dosyanız makro çalıştırabilen dosya formatında olmalı (xlsm, xlsb,xls gibi)
2 - alt + F11 ile ilgili sayfanın Vba sayfasını açın
3 - aşağıdaki kodları yapıştırın
modülün en başına hücrenin ilk değerini kaydeden değişken tanımı eklenir

Dim EskiDgr

hücreye odaklanıldığında hücrenin değeri aşağıdaki kod ile hafızaya alınır böylece içerik değiştiğinde eski veriye ulaşılabilir

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    EskiDgr = Target.Value

End Sub

içerik değiştiğinde eski değerin yeri bulunup yan gücredeki değer alınır
yeni değerin yeri bulunup veri oraya taşınır

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A:A")) Is Nothing Then

YeniDgr = Target.Value

    Set AramaE = Range("D").Find(what:=EskiDgr, LookIn:=xlValues, lookat:=xlWhole)

    Set AramaY = Range("D").Find(what:=YeniDgr, LookIn:=xlValues, lookat:=xlWhole)

    If Not AramaE Is Nothing Then If Not AramaY Is Nothing Then _

                xDgr = AramaE.Offset(, 1).Value: AramaY.Offset(, 1).Value = xDgr: AramaE.Offset(, 1).Value = ""

End If

End Sub

HOCAM EMEGİZİNE SAĞLIK ANCAK İNDİRDIM OLMUYOR YASS HAREKET ETMİYOR

denedim çalışıyor

HOCAM COK COK TESSEKKURLER KODU MANUEL KENDIM YAZINCA OLDU PCDEN PC FARKLILIKM GÖSTERİYOR SANIRIM ANCAK BEN BU Excel İÇERİSİNDE BASKA BİR SAYFA DAHA ACTIM DİĞER SAYFAYLA NASIL BAĞLAYA BİLİRİM BU KODU Excel SAYFA 1 DE DEĞER GİREYİM SAYFA 2 DE BU DEĞİŞKENLER DEĞİŞŞİN İSTİYORUM