Başka excel dosyasından birim adlarına göre veri almak

[tigiy]

Merhabalar

İki excel dosyam var birinde veriler var diğerinde ise görüntülemek istediğim tablo örnekle anlatmaya çalıştım.
Şimdiden yardımlarınız için teşekkür ederim

 

[Emir Hüseyin Çoban]

. . .

Dosyanız ektedir.
Aranan veriler veritabanı ile aynı olmalı. Örneğin Aranan: İzmir veritabanında İZMİR yazarsa bulamaz.

...::: Ekli Dosyayı İndirmek İçin Linki Tıklayınız :::...
http://yadi.sk/d/FohcPKauGF4Xz

Sub KOD()
Application.ScreenUpdating = False
Dim Con As Object, Rs As Object
Dim Sorgu As String
Set Con = CreateObject("Adodb.Connection")
Set Rs = CreateObject("Adodb.RecordSet")

Range("A2:D65536").ClearContents
yol = ThisWorkbook.Path & "\DATA.xls"

Con.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & ";extended properties=""excel 8.0;hdr=yes"""
Sorgu = "SELECT [personel no],[Ad],[Soyad],[Maaş] FROM [Sayfa1$] where [Birim] like '" & Range("H3") & "'"

Rs.Open Sorgu, Con, 3, 1

If Rs.RecordCount = 0 Then
MsgBox " Aranan Birimde Veri Yok ", vbCritical
Else
Range("A2").CopyFromRecordset Rs
End If

Rs.Close
Con.Close

Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
yol = Empty
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub

. . .

 

[tigiy]

Hüseyin bey çok teşekkür ederim fakat makro ile yapmak istemiyorum fonkisyon kullanarak yapmak istiyorum

 

[tigiy]

Yok mu arkadaşlar yardımcı olacak