Başka Hücreden Veriyi Sabit Olarak Çekme

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
örnek dosyada da belirttiğimiz gibi. B10 hücresine bir ürün girdiğimizde, H10 hücresinde kalıcı olarak geliş fiyatını almak istiyoruz. Bunu H sütununda tamamen uygulamak istiyoruz. T sütunundaki geliş fiyatları değişken olduğu için, biz o anki fiyatı sabit olarak almak istiyoruz. şimdiden çok teşekkür ediyorum.
 

Ekli dosyalar

Merhabalar Sn. Epak ambalaj,
S sütunundaki ürünler bir kez yazılıyorsa yani aynı ürün başka satırda tekrarlamıyorsa; aşağıdaki kodları kullanabilirsiniz.

-- Sayfa1 'in kod bölümüne ekleyiniz.
VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
    Columns("S:S").Select
    Cells.Find(What:=Target.Value).Select
    Target.Offset(0, 6).Value = Range(ActiveCell.Address).Offset(0, 1).Value
    Target.Offset(1, 0).Select
Application.ScreenUpdating = True
End Sub
 
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
If (Target.Column = 1 Or Target.Column = 4) And Target.Row > 1 Then
   For a = 10 To 8000 Step 32
        If Target.Row = a And Target.Column = 1 Then
            Cells(Target.Row - 2, 1) = Date
            Exit For
        ElseIf Target.Row = a + 23 And Target.Column = 4 Then
            Cells(Target.Row, 3) = Date
            Exit For
        End If
    Next a
End If
Application.EnableEvents = True
End Sub
 
Merhabalar;
Aşağıdaki şekilde deneyiniz.
VBA:
Private Sub Worksheet_Change(ByVal Target As Range)

If Selection.Count = 1 Then 'Exit Sub

Application.EnableEvents = False
    If (Target.Column = 1 Or Target.Column = 4) And Target.Row > 1 Then
        For a = 10 To 8000 Step 32
            If Target.Row = a And Target.Column = 1 Then
                Cells(Target.Row - 2, 1) = Date
                Exit For
            ElseIf Target.Row = a + 23 And Target.Column = 4 Then
                Cells(Target.Row, 3) = Date
                Exit For
            End If
        Next a
    End If
End If
Application.EnableEvents = True

'----------------------------------------------------------------------------

If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
    Columns("S:S").Select
    Cells.Find(What:=Target.Value).Select
    Target.Offset(0, 6).Value = Range(ActiveCell.Address).Offset(0, 1).Value
    Target.Offset(1, 0).Select
Application.ScreenUpdating = True

End Sub
 
Merhabalar;

İlk paylaştığınız dosyada ve son paylaştığınız dosyada da T sütunundaki değeri değiştirdim ama H sütunundaki değer değişmiyor.

Aşağıda belirttiğim kod satırı, H sütununda ilgili hücrede bulunan Formülün üzerine T sütunundaki değeri yazdığı için, T sütununda değer değiştirdiğiniz zaman H sütunundaki ilgili hücrede değer değişmez.
VBA:
Target.Offset(0, 6).Value = Range(ActiveCell.Address).Offset(0, 1).Value
 
Merhabalar;
Son gönderdiğiniz örnek dosyanın ekran görüntüsü ektedir.
-- B sütununa ürün ismi yazınca, H sütununa T sütunundan fiyat bilgisi geliyor.
-- T sütununda değişiklik yapıldığı zaman, ilk yazılan fiyat bilgileri aynı kalıyor.

Eğer hata almaya devam ediyorsanız, dosyanızın aslını, içinde gerçek bilgiler bulunmadan, örnek kayıtlar ile paylaşınız.

ornek-ekran-goruntusu.webp
 
bilgisayarı kapatıp açtım yine olmadı hocam.
dosya buradan atılmıyor.
örnek olarak verdiğim dosya da aynı şekilde sonuç vermiyor.
bizim excel 2010 olduğu için olabilir mi acaba
 
Merhabalar;
Bende, Office 2010 kullanıyorum.
Dosya boyutu fazla ise Dosya Yükleme siteleri ya da Google Drive aracılığı ile bağlantı adresi paylaşabilirsiniz.
 
Sayın Epak ambalaj,

Şu an Sayın AhmetRasim çevrimiçi değil.
Ben bir öneride bulunayım.
Dosyanızda mevcut kodu aşağıdakiyle değiştirerek deneyiniz.
Eklenen/değiştirilen kısımları kırmızı renklendirdim.

Dikkat: R sütnundaki ürünlerin sütunda 1'er kez yer alacağı ve B sütununa yazılacak ürün adlarının
R sütunundakilerle birebir aynı olacak şekilde elle yazılacağı veya açılır listeden seçileceği varsayılmıştır.
Ancak;
60x80 ince yağlı kağıt .isimli ürün hem 258 ve hem de 261'inci satırda var.
B sütununa bu ürün yazıldığında 258'inci satırdaki değer getirilir.


VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
If (Target.Column = 1 [COLOR=rgb(132, 53, 52)]Or Target.Column = 2[/COLOR] Or Target.Column = 4) And Target.Row > 1 Then
    For a = 10 To 8000 Step 32
        If Target.Row = a And Target.Column = 1 Then
            Cells(Target.Row - 2, 1) = Date
            Exit For
        ElseIf Target.Row = a + 23 And Target.Column = 4 Then
            Cells(Target.Row, 3) = Date
            Exit For
[COLOR=rgb(132, 53, 52)]        ElseIf Target.Row >= a And Target.Row <= a + 19 And Target.Column = 2 Then
            Set bul = [R:R].Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
            If Not bul Is Nothing Then Target.Offset(0, 6) = Cells(bul.Row, "S")
            If bul Is Nothing Then: MsgBox "YAzılan ürün listede yok !", vbCritical
            Exit For[/COLOR]
        End If
    Next a
End If
Application.EnableEvents = True
End Sub
 
Sayın Ömer Baran hocam verdiğiniz kodu girdim.
B10 hücresine "küçük renkli ucuz" yazdığımda H10 hücresine mevcut geliş fiyatı çıkıyor.
daha sonra S sütunundaki geliş fiyatı değişince, evvelki satılan ürünün (H10) fiyatı da güncelleniyor.
biz daha önceki satılan ürünün fiyatı değişmemesini, sabit kalmasını istiyoruz.

verdiğiniz kodu girdim fakat, fiyat sabit kalmıyor.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst Alt