diğer dosyadan veri almak

[2008model]

değerli arkadaşlar merhaba

çalıştığım iki farklı dosya var.dostadan veri almak istiyorum.örnek dosyaları ekte yükledim.yardımınız için teşekkürler

 

[Orion1]

Dosyanız ektedir.
2 dosyanında ayni klasör içinde olamlıdır.
Kapalı dosyadan ado ile veri alır.

Sub dısardan_veri_al()
'Referanslardan microsoft activex object 2,8 library seçildi.
Dim i As Long, sat As Long, fiyat As Double, birim As String
Dim giris As Double, toplam As Double
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("C3:F65536").ClearContents
Set conn = New ADODB.Connection
conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & _
ThisWorkbook.Path & "\costtanzer.xls;extended properties=""excel 8.0;hdr=yes""")
Set rs = New ADODB.Recordset
For i = 3 To Cells(65536, "B").End(xlUp).Row
    rs.Open "select * from [Sayfa1$] where Ürün = '" & Cells(i, "B").Value & "';", conn, adOpenDynamic, adLockOptimistic
    fiyat = 0: birim = "": giris = 0: toplam = 0
    rs.MoveFirst
    Do While Not rs.EOF
        fiyat = rs(1).Value
        birim = rs(2).Value
        giris = giris + rs(3).Value
        toplam = toplam + rs(4).Value
        rs.MoveNext
    Loop
    Cells(i, "C").Value = fiyat
    Cells(i, "D").Value = birim
    Cells(i, "E").Value = giris
    Cells(i, "F").Value = toplam
    rs.Close
Next i
conn.Close
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[metin_1]

Private Sub Workbook_Open()

On Error Resume Next
Workbooks.Open ("c:\costtanzer.xls")
Application.DisplayAlerts = False

son = Workbooks("costtanzer.xls").Sheets(1).Rows.Count
sonö = Workbooks("örnek.xls").Sheets(1).Rows.Count
sondeğer = Workbooks("costtanzer.xls").Sheets(1).Cells(Workbooks("costtanzer.xls").Sheets(1).Rows.Count, "B").End(xlUp)

For i = 3 To son

sayaç = 0

For j = 3 To son

If Workbooks("örnek.xls").Sheets(1).Cells(j, 2).Value = "" Then sayaç = sayaç + 1

If Workbooks("costtanzer.xls").Sheets(1).Cells(i, 2).Value <> "" And Workbooks("costtanzer.xls").Sheets(1).Cells(i, 2).Value = Workbooks("örnek.xls").Sheets(1).Cells(j, 2).Value Then
Workbooks("örnek.xls").Sheets(1).Cells(j, 3).Value = Workbooks("costtanzer.xls").Sheets(1).Cells(i, 3).Value
Workbooks("örnek.xls").Sheets(1).Cells(j, 4).Value = Workbooks("costtanzer.xls").Sheets(1).Cells(i, 4).Value
Workbooks("örnek.xls").Sheets(1).Cells(j, 5).Value = Workbooks("costtanzer.xls").Sheets(1).Cells(i, 5).Value
Workbooks("örnek.xls").Sheets(1).Cells(j, 6).Value = Workbooks("costtanzer.xls").Sheets(1).Cells(i, 6).Value
Exit For
End If

If sayaç > 3 Then Exit For

Next j

If Workbooks("costtanzer.xls").Sheets(1).Cells(i, 2).Value = sondeğer Then Exit For

Next i

Workbooks("costtanzer.xls").Close
Application.DisplayAlerts = True


End Sub




4'üncü satırda dosyanın yolunu gösterirsen daha iyi çalışır yoksa dosyayı senin açman gerekiyor. Makro sonunda da dosyayı kapatır. Eğer sen açtıysan kaydetmeyi unutma.

 

[2008model]

evren hocam ve metin_1 hocam sizlere çok tewşekkür ediyorum yardımınız için.ancak ben prof. kullanıcı değilim makrolar hakkında.ben bu kodlara ilave yapmam lazım onun için daha basit anlaşılır olmalı.mantığınıda çözmem lazım.yoksa kodlar süper ama benim anlayabilmem lazım... yani sorun bende dostlarr

 

[metin_1]

Evren hocamın dosyasını aynı klasöre kopyalarsan işini görecektir.

 

[2008model]

evren hocam benim orjinal dosyama uyguladığımda "user-defined type not defined" hata mesajı alıyorum ve makronun şu kısmını işaret ediyor.(örnek dosyam : excell 2007)

"conn As ADODB.Connection" sorun nerede acaba?

 

[Zeki Gürsoy]

Merhaba,

İlgili referansı ekleyiniz.. "Microsoft ActiveX Data Object 2.? Library"

 

[Orion1]

evren hocam benim orjinal dosyama uyguladığımda "user-defined type not defined" hata mesajı alıyorum ve makronun şu kısmını işaret ediyor.(örnek dosyam : excell 2007)

"conn As ADODB.Connection" sorun nerede acaba?

İlgili referansı ekleyiniz.. "Microsoft ActiveX Data Object 2.? Library"

Ben kodların en başında belirtmiştim.
Zeki hocamda belirtmiş.

 

[2008model]

evren hocam "Microsoft ActiveX Data Object 2.? Library" kodunu ekleyebilirmisiniz siden rica etsem.

 

[Orion1]

evren hocam "Microsoft ActiveX Data Object 2.? Library" kodunu ekleyebilirmisiniz siden rica etsem.

Bu kod değildir.
VBE'de Tools==>Referance den ilgili refransı seçip tikleyip tamam basın.İşlem tamamdır.

 

[2008model]

evren hocam teşekkür ederim.hallettim kodu tekrar deneyeceğim