makro ile düşey ara formülü

P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
297
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
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
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
 
P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
297
Excel Vers. ve Dili
microsoft office professional plus 2016
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.
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
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
 
P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
297
Excel Vers. ve Dili
microsoft office professional plus 2016
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.
 
P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
297
Excel Vers. ve Dili
microsoft office professional plus 2016
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
 
Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

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

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

.
 
P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
297
Excel Vers. ve Dili
microsoft office professional plus 2016
Ö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
 
Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
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
 
Ömer

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
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
 
P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
297
Excel Vers. ve Dili
microsoft office professional plus 2016
Ö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.
Üst