VBA İLE DÜŞEYARA SÜREKLİ AKTİF OLSUN

[kucuksinai]

Arkadaşlar merhaba,

Bu videoda hocamız VBA ile Düşeyara fonksiyonunu nasıl yapacağımız anlatıyor. Fakat VBA ile yazılan kod, formül ile yazımdan artı olarak bir de GETİR şeklinde bir butona muhtaç. (16:20 dk da görebilirsiniz) Fakat benim istediğim bu buton olmadan VBA kodumuz sürekli aktif olsun. Yani bir GETİR tuşuna basmayalım. Sol sütundan seçimi yaptığımızda sağ sütun DÜŞEYARA'da olduğu gibi direkt olarak gelsin. VBA ile yaptığımızda bu mümkün müdür? Teşekkürler.

 

[muratboz06]

Merhaba,
Böyle bir örnek için B2 hücresine formül yazmak daha basit bir çözüm olacaktır, makro ile çözüm uzatılmış olur.
Eğer(a2<>"";düşeyara(....);"") gibi bir formül.
A sütununda birden çok satıra isim yazarak yanına veri getirmek istiyorsanız o başka bir konu.

 

[kucuksinai]

Merhaba,
Böyle bir örnek için B2 hücresine formül yazmak daha basit bir çözüm olacaktır, makro ile çözüm uzatılmış olur.
Eğer(a2<>"";düşeyara(....);"") gibi bir formül.
A sütununda birden çok satıra isim yazarak yanına veri getirmek istiyorsanız o başka bir konu.

Bu formül ile neyi ifade ettiğinizi tam anlayamadım? Benim sorum basit aslında. VBA ile düşeyarama işlemi "GETİR" şeklinde bir butona muhtaç mıdır?

 

[muratboz06]

Hayır değildir.
Örnek çalışmayı indirip, bakabilirsiniz
Sayfa1 de A2 hücresindeki veriyi değiştirerek, B2 deki verinin değiştiğini görebilirsiniz.

DuseyAraOrnek.xlsm dosyasını indir - download

DuseyAraOrnek.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[kucuksinai]

Hayır değildir.
Örnek çalışmayı indirip, bakabilirsiniz
Sayfa1 de A2 hücresindeki veriyi değiştirerek, B2 deki verinin değiştiğini görebilirsiniz.

DuseyAraOrnek.xlsm dosyasını indir - download

DuseyAraOrnek.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

Harika! Bahsettiğim şey tam olarak buydu. Excel'de yeniyim, basit sorular soruyor olabilirim. İlgilendiğiniz için çok teşekkürler!

 

[Volkan1107]

Hayır değildir.
Örnek çalışmayı indirip, bakabilirsiniz
Sayfa1 de A2 hücresindeki veriyi değiştirerek, B2 deki verinin değiştiğini görebilirsiniz.

DuseyAraOrnek.xlsm dosyasını indir - download

DuseyAraOrnek.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

Merhaba örnek çok güzel emeğinize sağlık

Çalışmadaki örnekte yer alan, adı ve soyadı hücresindeki değerleri altındaki 3,4,5,6.... satırlara da yapılabilir mi acaba?

 

[muratboz06]

Yukarıdaki çalışmadaki Sayfa1 in kod bölümüne aşağıdaki kodu yazarsanız. A2:A10 hücre aralığına veri girişi yapıldığında yanındaki hücreye, Liste sayfasında arama yapar ve eğer varsya 2. sütündaki değeri getir, eğer yoksa boş bırakır.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    Dim KeyCells    As Range
   
    Set KeyCells = Range("A2:A10")
   
   If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        If Target.Value = "" Then
        Target.Offset(0, 1) = ""
        Exit Sub
    Else
        Target.Offset(0, 1) = Application.WorksheetFunction.VLookup(Target.Value, Worksheets("Liste").Range("A1").CurrentRegion, 2, 0)
        Exit Sub
    End If
End If
End Sub

 

[Volkan1107]

Yukarıdaki çalışmadaki Sayfa1 in kod bölümüne aşağıdaki kodu yazarsanız. A2:A10 hücre aralığına veri girişi yapıldığında yanındaki hücreye, Liste sayfasında arama yapar ve eğer varsya 2. sütündaki değeri getir, eğer yoksa boş bırakır.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    Dim KeyCells    As Range
  
    Set KeyCells = Range("A2:A10")
  
   If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        If Target.Value = "" Then
        Target.Offset(0, 1) = ""
        Exit Sub
    Else
        Target.Offset(0, 1) = Application.WorksheetFunction.VLookup(Target.Value, Worksheets("Liste").Range("A1").CurrentRegion, 2, 0)
        Exit Sub
    End If
End If
End Sub

Çok teşekkürler. Çok faydalı olduğu emeğinize sağlık.

 

[uzmanamele]

Merhaba

Yerleşik fonksiyon varken butür kodları kullanmanızı önermem.
Hele de vba konusunda acemi birisi bunu kullanmamalı.
Örneğin, dosyayı açan kişi makroyu etkinleştirmemiş olabilir. Siz kod çalıştı doğru sonuç geldi sanırınız, hata yaparsınız.
Mesela bey çoğunlukla A sütununu boş bırakırım, tablonun soluna hakim olmak için.
Biri bu alışkanlıkla sütun ekler, sizin kodlar hata verir, neler olduğunu da çözemeyebilirsiniz.

 

[Necdet]

Merhaba,

Hocanız VBA'da WorkSheetFunction konusunu işlediği için olay basit gibi olabilir. Madem vba da acemi iseniz farklı yöntemi aşağıdaki kodları Muratboz06 arkadaşımızın dosyasında A sütununda herhangi bir hücrede uygulayabilirsiniz.

DÜŞEYARA değil WBA nın Find komutu kullanılmıştır.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    Dim c As Range
    
    Set c = Sayfa2.Range("A:A").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Cells(Target.Row, "B") = Sayfa2.Range("B" & c.Row)
'        Target.Offset(0, 1) = Sayfa2.Range("B" & c.Row)
    Else
        Cells(Target.Row, "B") = "Bulunamadı....."
'        Target.Offset(0, 1) = "Bulunamadı....."
    End If
    
End Sub

 

[Korhan Ayhan]

Hücreler kilitli olduğu zaman bu vba kodları çalışmıyor. Unprotect komutlarıyla şifre değeri girilerek yapılabiliyor diye biliyorum. Şifre değerini bilmeden bunu yapmanın yolu yok mu?

Sayfa koruması eklemeden önce hücrelerin kilidini kaldırırsanız olabilir. Bunun dışında sayfa koruma şifresini bilmeniz gerekir.

 

[TUNCA ERSİN]

sy. Hocalarım ;

kopyala yapıştır yapınca bir tane sonuç geliyor diğerleri gelmiyor ona nasıl bir çözüm olabilir teşekkür ederim.

Merhaba,

Hocanız VBA'da WorkSheetFunction konusunu işlediği için olay basit gibi olabilir. Madem vba da acemi iseniz farklı yöntemi aşağıdaki kodları Muratboz06 arkadaşımızın dosyasında A sütununda herhangi bir hücrede uygulayabilirsiniz.

DÜŞEYARA değil WBA nın Find komutu kullanılmıştır.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Then Exit Sub
   
    Dim c As Range
   
    Set c = Sayfa2.Range("A:A").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Cells(Target.Row, "B") = Sayfa2.Range("B" & c.Row)
'        Target.Offset(0, 1) = Sayfa2.Range("B" & c.Row)
    Else
        Cells(Target.Row, "B") = "Bulunamadı....."
'        Target.Offset(0, 1) = "Bulunamadı....."
    End If
   
End Sub