Excel Atadıgım Değerle Sutun İçesindeki Yazı Yukarıya Asagıya Tasınsın

(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

Dim EskiDgr

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    EskiDgr = Target.Value

End Sub

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
    Set AramaY = Range("D
    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
    Set AramaY = Range("D
    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