Makro ile Düşeyara

seddur

Altın Üye
Katılım
12 Nisan 2012
Mesajlar
531
Excel Vers. ve Dili
Microsoft office professional plus 2019
Altın Üyelik Bitiş Tarihi
18-12-2024
Arkadaşlar çok pratik bir kullanımının olduğunu düşündüğüm MAKRO İLE DÜŞEYARA nasıl yapılır.İntenetde bulduğum örnekler güzel ama hiçbirini çalıştıramadım.Elinde makro örneği bulunan ya da sıfırdan yazabilecek arkadaş varsa çok sevinirim.Benim anladığım bir inputbox açılacak ve aranan değerler buraya yazıldıktan sonra istenen sonuç bulunacak.
 
Katılım
25 Mart 2019
Mesajlar
30
Excel Vers. ve Dili
Excel 2016 , İngilizce
Altın Üyelik Bitiş Tarihi
25-03-2020
Mantık şu ;

Belli hücrelerde aramak istediğin bilgiler olacak ,
Combobox ile aranacak değer istenecek bunu da if yapısı ile sağlayabilirsin mesela Bilgiconline değerinin yanındaki değeri alacaksın,

Kod:
If ComboBox1.Text = "Bilgiconline" Then
daha sonra VLOOKUP vba kodunu yazacaksın ,

en son olarak değeri getirmek istediğin range seçimini yapıp kodu bitereceksin.

Kusura bakma dışarıdayım tabletten yazıyorum o yüzden kodu yazamayacağım .

İyi çalışmalar.
 
Katılım
6 Mart 2005
Mesajlar
6,233
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
Kod:
Sub arama()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1"): Set wf = WorksheetFunction
Bul = InputBox("Aranan değeri giriniz")
If Bul = "" Then
MsgBox "Değer girmediniz"
Exit Sub
   End If
 if wf.CountIf(s1.Range("B2:B200"), Bul)=0 Then
MsgBox "Aradığınız değer bulunamadı"
Exit Sub
   End If
   Var = wf.VLookup(Bul, s1.Range("B2:D200"), 3, 0)
   MsgBox "Aradığınız değer " & Var
End Sub
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,374
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhbba,

Ben olsam makro ile DÜŞEYARA kullanmam, makrodaki FIND komutunu kullanırım.
Makronun yardımında FIND komutunun kullanışını bulabilirsiniz.
 
Son düzenleme:

seddur

Altın Üye
Katılım
12 Nisan 2012
Mesajlar
531
Excel Vers. ve Dili
Microsoft office professional plus 2019
Altın Üyelik Bitiş Tarihi
18-12-2024
Kod için çok teşekkür ederim.Kod hata vermiyor.
 
Son düzenleme:

seddur

Altın Üye
Katılım
12 Nisan 2012
Mesajlar
531
Excel Vers. ve Dili
Microsoft office professional plus 2019
Altın Üyelik Bitiş Tarihi
18-12-2024
Kod:
Sub arama()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1"): Set wf = WorksheetFunction
Bul = InputBox("Aranan değeri giriniz")
If Bul = "" Then
MsgBox "Değer girmediniz"
Exit Sub
   End If
  Bak = wf.CountIf(s1.Range("B2:B200"), Bul)
  If Bak = 0 Then
  MsgBox "Aradığınız değer bulunamadı"
Exit Sub
   End If
   Var = wf.VLookup(Bul, s1.Range("B2:D200"), 3, 0)
   MsgBox "Aradığınız değer " & Var
End Sub
 

seddur

Altın Üye
Katılım
12 Nisan 2012
Mesajlar
531
Excel Vers. ve Dili
Microsoft office professional plus 2019
Altın Üyelik Bitiş Tarihi
18-12-2024
Kod da adı geçen"var" ile "bak" değerleri arasındaki farkı yazabilirmisin.
 

gicimi

Altın Üye
Katılım
3 Şubat 2008
Mesajlar
593
Excel Vers. ve Dili
Office 2016 Eng. 64 Bit
Altın Üyelik Bitiş Tarihi
21-11-2024
@Necdet Hocam bir örnek paylaşabilir misiniz. Mümkünse.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,374
Excel Vers. ve Dili
Ofis 365 Türkçe
@Necdet Hocam bir örnek paylaşabilir misiniz. Mümkünse.
Merhaba,

Aşağıdaki kodlar H2 hücresinde yazılan değeri A sütununda arar ve kaç adet bulursa I sütununda listeler.

Find kodunu makronun yardımından Range.Find olarak aratınca verdiği kodlardır.
Daha fazla açıklama orada var.

İkinci kod dosya içinde yok ama sadece aranan değerin olup olmadığını söyler.
Bu kodları kendinize göre uyarlamanız gerekir.

Kod:
Sub Ara()

    Dim i   As Integer, _
        c   As Range, _
        Syf As Worksheet, _
        Deg As String, _
        Adr As String
   
    Set Syf = Sheets("Sayfa1")
   
    Range("I2:K100").ClearContents
   
    Deg = Range("H2")
    i = 1
   
    With Syf.Range("A:A")
        Set c = .Find(Deg, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                i = i + 1
                Syf.Cells(i, "I") = c.Value
                Syf.Cells(i, "J") = c.Offset(0, 1)
                Syf.Cells(i, "K") = c.Offset(0, 2)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
   
End Sub
Kod:
Sub AraTek()

    Dim i   As Integer, _
        c   As Range, _
        Syf As Worksheet, _
        Deg As String, _
        Adr As String
    
    Set Syf = Sheets("Sayfa1")
    
    Range("I2:K100").ClearContents
    
    Deg = Range("H2")
    
    With Syf.Range("A:A")
        Set c = .Find(Deg, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            MsgBox "Aranan Değer Var"
        Else
            MsgBox "Aranan Değer Yok"
        End If
    End With
    
End Sub
 

Ekli dosyalar

Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
Altın Üyelik Bitiş Tarihi
21-07-2024
Üstad, kod çok kullanışlı olmuş, elinize sağlık. iyi çalışmalar.
 

gicimi

Altın Üye
Katılım
3 Şubat 2008
Mesajlar
593
Excel Vers. ve Dili
Office 2016 Eng. 64 Bit
Altın Üyelik Bitiş Tarihi
21-11-2024
@Necdet hocam paylaşım ve bilgilendirme için teşekkür ederim.

HTC One_M8 cihazımdan Tapatalk kullanılarak gönderildi
 
Üst