elimdeki listeye tel noları eklemek

[baYNetci]

[/FLASH]elimdeki örnek (A excel çalışma) listede borçlular var diğer elimdeki (B excel çalışma) listemde ADI SOYADI telefon var (b excel çalışma) listesinde çok fazla veri var sadece (a excel) listesine (b excel çalışma)nın telini almak istiyorum. yardım edebilecek varmı acaba

 

[Orion1]

elimdeki örnek (A excel çalışma) listede borçlular var diğer elimdeki (B excel çalışma) listemde ADI SOYADI telefon var (b excel çalışma) listesinde çok fazla veri var sadece (a excel) listesine (b excel çalışma)nın telini almak istiyorum. yardım edebilecek varmı acaba

Örnek Dosya/dosyalarınızı eklerseniz daha hızlı cevap alabilirsiniz

 

[baYNetci]

tamam ekledim

 

[Doğan1]

Düşeyara formülü ile rahatlıkla veri çekebilirsiniz.. Örnek aşağıdaki gibidir..

D2 =DÜŞEYARA(A2;'[B EXCEL.xls]LISTE'!$A$2:$C$444;3;0)

 

[baYNetci]

çok güzel teşekkür ederim ama 200 yakın kaydı buldu diğerlerini bulamadı #yok diyor halbuki var

 

[baYNetci]

tamamdır çok çok teşekkürler 444 de kadar veriyi çekebiliyormuş ben 4444 yaptım düzeldi

 

[Orion1]

Dosyanız ektedir.

Sub telaktar59()
Dim k As Range, i As Long, sat1 As Long, sat2 As Long, wb As Workbook, sh As Worksheet
Range("D2:D" & Rows.Count).ClearContents
If Workbooks.Open(ThisWorkbook.Path & "\B EXCEL.xls").ReadOnly = True Then
    Workbooks("B EXCEL.xls").Close False
End If
ThisWorkbook.Activate
Application.ScreenUpdating = False
Set wb = Workbooks("B EXCEL.xls")
Set sh = wb.Sheets("LISTE")
sat1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
sat2 = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sat2
    Set k = sh.Range("A2:A" & sat1).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Cells(i, "D").Value = k.Offset(0, 2).Value
    Set k = Nothing
Next i
wb.Close False
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly
End Sub

 

[Doğan1]

Sanırım kullandığınız tablo gönderdiklerinizden daha büyük.. Birde aşağıdakini deneyin..

=DÜŞEYARA(A2;'[B EXCEL.xls]LISTE'!$A:$C;3;0)

 

[baYNetci]

Dosyanız ektedir.

Sub telaktar59()
Dim k As Range, i As Long, sat1 As Long, sat2 As Long, wb As Workbook, sh As Worksheet
Range("D2:D" & Rows.Count).ClearContents
If Workbooks.Open(ThisWorkbook.Path & "\B EXCEL.xls").ReadOnly = True Then
    Workbooks("B EXCEL.xls").Close False
End If
ThisWorkbook.Activate
Application.ScreenUpdating = False
Set wb = Workbooks("B EXCEL.xls")
Set sh = wb.Sheets("LISTE")
sat1 = sh.Cells(Rows.Count, "A").End(xlUp).Row
sat2 = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sat2
    Set k = sh.Range("A2:A" & sat1).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Cells(i, "D").Value = k.Offset(0, 2).Value
    Set k = Nothing
Next i
wb.Close False
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly
End Sub

çok teşekkür ederim. allah razı olsun. ölmüşlerinize duacıyım saygılar ve sevgiler

 

[baYNetci]

Sanırım kullandığınız tablo gönderdiklerinizden daha büyük.. Birde aşağıdakini deneyin..

=DÜŞEYARA(A2;'[B EXCEL.xls]LISTE'!$A:$C;3;0)

evet çok daha fazlaydı çünkü gsm numaralarına borç bildirimi yapılacak yarın dahi çalışacaktım bu yüzden doğan bey allah razı olsun yarabbim sizin gibi yardımsever insanları sevdiklerine bağışlasın.

 

[Doğan1]

Eyvallah çok teşekkür ederim.. Umarım o borç listesinde bizimde adımız yoktur iyi akşamlar dilerim..