• DİKKAT

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

makro ile düşey ara formülü

P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
299
Excel Vers. ve Dili
microsoft office professional plus 2016
merhaba arkadaşlar...
excel tablsunda 2 sayfam var. Sayfa 1 de bulunan ve düşeyara ile yazmış olduğum formülleri makro ile yazarsam çok iyi olacak. Sayfa 1 deki formüller üzeri sarı dolgu ile boyalı bu formüler sayfa 2 den veri alıyor. Aşağıda örnek tablomun linkini verdim. yardımlarınız için şimdiden çok teşekkürler..





https://s7.dosya.tc/server20/umy0af/ornek.xlsx.html
 
Merhaba.

Kod: 
Sub Test()
    Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
    Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
    Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
    Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
    Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
    Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
    Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
    Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
    Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
    Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
    Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
    Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)
End Sub
 
Muzaffer Ali' Alıntı:
Merhaba.

Kod: 
Sub Test()
    Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
    Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
    Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
    Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
    Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
    Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
    Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
    Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
    Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
    Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
    Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
    Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)
End Sub
Genişletmek için tıkla ...
Öncelikle teşekkür ederim Muzaffer bey elinize emeğinize sağlık...
- makroyu otomatik çalıştırmıyor ben c3 hücresini bilgiyi girdiğimde hepsi otomatik gelmesi lazım ama gelmiyor ben kod sayfasına girip makroyu çalıştır dersem çalışıyor
-makroyu sayfa 1 in koduna mı yazayım yoksa yeni bir modül yapıp onamı yazayım bilemedim
-tabloyu kayıt ederken dikat belgenizin bazı bölümleri belge denetçisi tarafında kişisel bilgiler içeriyor olabilir diye mesaj geliyor.
 
Aşağıdaki kodu Sayfa1'in kod kısmına kopyalayın.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C3"), Target) Is Nothing Then
        Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
        Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
        Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
        Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
        Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
        Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
        Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
        Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
        Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
        Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
        Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
        Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)
    End If
End Sub
 
Muzaffer Ali' Alıntı:
Aşağıdaki kodu Sayfa1'in kod kısmına kopyalayın.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C3"), Target) Is Nothing Then
        Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
        Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
        Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
        Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
        Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
        Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
        Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
        Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
        Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
        Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
        Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
        Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)
    End If
End Sub
Genişletmek için tıkla ...
çok teşekkür ederim muzaffer bey istediğim gibi oldu bilginize sağlık.
 
Arkadaşlar yukarıdaki formül çok güzel çalışıyor lâkin bazen kullandıkça birşeyler ilave etmek gerekiyor. Şöyleki...
Aranan değer kısmına olmayan bir değer girdiğimde bir önceki doğru olan değer kalıyor bende onu yazdırıyorum lâkin aynı sayfayı 2 kez yazdırmış oluyorum acaba makroya aranan değer yanlış girildiğinde veri hücreleri boş olsa olurmu. Eskiden formül varken yanlış yazdimmi YOK yazardi teşekkürler şimdiden
 
Merhaba,

İf not satırından sonra aşağıdaki satırı ekleyip deneyiniz.

Range("H3,C5:C6,C8:C13,E16:E18").ClearContents

.
 
Ömer' Alıntı:
Merhaba,

İf not satırından sonra aşağıdaki satırı ekleyip deneyiniz.

Range("H3,C5:C6,C8:C13,E16:E18").ClearContents

.
Genişletmek için tıkla ...
merhaba ömer bey ilginiz için teşekkür ederim.
dediğiniz gibi yaptım çalışmadı ben yukardaki formüle ilaveten next döngüsünü de ilave etmiştim ondan çalışmıyo olabilirmi yaptığı kodlama aşağıdadır hocam.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Range("C3"), Target) Is Nothing Then
Range("H3,C5:C6,C8:C13,E16:E18").ClearContents
Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
Range("C7") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 4, 0)
Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)

End If
End Sub
 
Aşağıdaki adrese örnek dosya ekleyip açıklayınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.
dosya.co
 
Deneyiniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo atla:
    If Not Intersect(Range("C3"), Target) Is Nothing Then
        Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
        Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
        Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
        Range("C7") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 4, 0)
        Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
        Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
        Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
        Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
        Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
        Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
        Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
        Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
        Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)
    End If
    Exit Sub
atla:
    Range("H3,C5:C13,E16:E18") = ""
End Sub
 
Ömer' Alıntı:
Deneyiniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo atla:
    If Not Intersect(Range("C3"), Target) Is Nothing Then
        Range("H3") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 3, 0)
        Range("C5") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 18, 0)
        Range("C6") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 19, 0)
        Range("C7") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 4, 0)
        Range("C8") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 5, 0)
        Range("C9") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 6, 0)
        Range("C10") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 7, 0)
        Range("C11") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 8, 0)
        Range("C12") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 9, 0)
        Range("C13") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 10, 0)
        Range("E16") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 15, 0)
        Range("E17") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 16, 0)
        Range("E18") = WorksheetFunction.VLookup(Range("C3"), Worksheets("Sayfa2").Range("A:S"), 17, 0)
    End If
    Exit Sub
atla:
    Range("H3,C5:C13,E16:E18") = ""
End Sub
Genişletmek için tıkla ...
Ömer hocam çok teşekkür ederim elinize emeğinize bilginize sağlık. hayırlı günler hocam
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst