Çokludüşeyara KTF nasıl uygulanır?

[Tevfik_Kursun]

Merhaba Arkadaşlar,

Function ÇOKLUDÜŞEYARA(aranan As String, alan As Range, sutun As Integer) As String
If aranan = "" Or sutun = 0 Then GoTo cik
veri = alan.Value2
For i = 1 To UBound(veri)
    If veri(i, 1) Like aranan Then
        ÇOKLUDÜŞEYARA = ÇOKLUDÜŞEYARA & veri(i, sütun) & vbLf
    End If
Next i
Exit Function
cik: ÇOKLUDÜŞEYARA = ""
End Function

verilen KTF ile A ve B sütunlarındaki listeden bilgi nasıl çekilir? Diyelim arananı F1 e yazdık, cevapları da G1, G2, ... sütununda listelesin istiyoruz. Nasıl listeleriz?

ali 5
veli 6
ali 7
ahmet 8
ayşe 9
musa 10
sultan 11
ahmet 12
mustafa 13
ahmet 14

Saygılarımla

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

=cokara($F$1;$A$1:$B$10;SATIR(A1))

Function cokara(aranan As Range, veri As Range, sira As Integer) As Integer

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

alan = veri.Worksheet.Name & "$" & veri.Address(0, 0)

sorgu = "select f2 from [" & alan & "] where f1 = '" & aranan.Value & "' "

Set rs = con.Execute(sorgu)
deg = rs.getrows

cokara = deg(0, sira - 1)

End Function

 

[Levent Menteşoğlu]

............. verilen KTF ile A ve B sütunlarındaki listeden bilgi nasıl çekilir? Diyelim arananı F1 e yazdık, cevapları da G1, G2, ... sütununda listelesin istiyoruz. Nasıl listeleriz?

ali 5
veli 6
ali 7
ahmet 8
ayşe 9
musa 10
sultan 11
ahmet 12
mustafa 13
ahmet 14

Bir fonksiyon sadece tek bir değer döndürür dolayısıyla listeleme yapamazsınız mutlaka bir prosedür yazmanız gerekir.

 

[Tevfik_Kursun]

Sayın Kuvari hocam çok teşekkür ederim.
Sayın Levent hocam, prosedür derken ne demek istediniz onu anlamadım.
İlgileriniz için her ikinize de teşekkür ederim.
saygılarımla

 

[Orion1]

Prosedür,sub ile başlayıp end sub ile biter.

Sub cokluara()
'kodlarınız
end sub.

 

[Tevfik_Kursun]

Sayın Evren hocam,
Bir çeşit (for next) veya (while wend) gibi mi? Gerçi ben her ne sebeptense her seferinde #DEĞER! ibaresini gördüm. İlk kez arka arkaya düşeyara sonucunu sayın Kuvari hocanın KTF sinde gördüm.
Saygılarımla

 

[Murat OSMA]

Birçok alternatif sunulabilir..

[SIZE="2"]Option Compare Text
Function Coklu_Getir(bul As Range, aranan As Range, sayı As Integer)
    Dim say As Integer, i As Integer
    For i = 1 To aranan.Count
        If bul = aranan.Cells(i) Then
            say = say + 1
            If say = sayı Then
                Coklu_Getir = aranan.Cells(i).Offset(0, 1).Value
                Exit Function
            End If
        End If
    Next i
    If say = 0 Then Coklu_Getir = ""
End Function[/SIZE]

Fonksiyonun kullanımı;

[SIZE="2"]=Coklu_Getir([COLOR="Red"]$F$1[/COLOR];[COLOR="Blue"]$A$1:$B$10[/COLOR];[COLOR="Magenta"]SATIR()[/COLOR])[/SIZE]

 

[Tevfik_Kursun]

Sayın Murat hocam,
İlginize teşekkür ederim.
Saygılarımla