• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kod üzerine ikinci sütunu eklemek

Katılım
28 Nisan 2008
Mesajlar
406
Excel Vers. ve Dili
Excel 2007- Türkce
merhaba,

asagidaki kodlarla sayfa2 den calisma sayfama bilgi aktariyorum. bu islem sadece R sütunu icin gecerli. ayni islemin ayni anda R ve E sütunlari icin kod üzerinde nasil bir degisiklik yapmam gerekiyor. Tesekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("R1:R65000")) Is Nothing Then
Target.Offset(, 1).Value = Application.VLookup(Target, Sheets("Sayfa2").Range("A:B"), 2, False)
If Target.Value = "" Then
Target.Offset(, 1).Value = ""
End If
End If
End Sub
 
şu kodu deneyiniz.
Kod:
If Not Intersect(Target, Range("R1:R65000" [B], "E1;E65000" [/B])) Is Nothing Then
 
merhaba,

tesekkürler ama islem gerceklesmedi. sayfa2 de A sütununda ürün kodu B sütununda ürün adlari var. 05 Portakal, 11 Elma gibi. calisma sayfamda R sütununa 11 yazdigim zaman karsisina S sütununa Elma yaziyor. ayni anda islemin E ve F sütunlarinda da olmasini istiyorum. yani R sütununa 11 yazdigim zaman karsina Elma yazacak ayni anda E ve F sütununda da 11 Elma yazacak. tesekkürler.
 
istediklerinizi içeren örnek bir dosya yükleyiniz, google drive a olabilir.
 
Örnek dosyanızda makro/kod bulunmuyor. Eğer isteğiniz R8'e veri girildiğinde S8'e karşılığının gelmesi ve aynı verilerin E8 ve F8'e aktarılmasıysa aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayınız:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [R1:R65000]) Is Nothing Then Exit Sub
If Target <> "" Then
    a = Target.Row
    son = Sheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("A1:A" & son), Target) > 0 Then
        Cells(a, "S") = WorksheetFunction.VLookup(Target, Sheets("Sayfa2").Range("A1:B" & son), 2, 0)
        Cells(a, "E") = Target
        Cells(a, "F") = Cells(a, "S")
    Else
        MsgBox "Girdiğiniz Kod Sayfa2'de bulunmuyor", vbCritical
        Application.EnableEvents = False
        Target = ""
        Cells(a, "S") = ""
        Cells(a, "E") = ""
        Cells(a, "F") = ""
        Target.Select
        Application.EnableEvents = True
    End If
End If
End Sub
 
YUSUF44 bey cok tesekkür ederim. ellerine saglik.
 
Geri
Üst