İki Farklı Dosyadan Şarta Göre Veri Aktarma...

M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Merhaba,

Benim sorunum, iki farklı dosya var. Veri dosyasının "D" sütunundaki verileri, Aktar dosyasının "F" sütununda bulup, "M" sütununda yazan KOD hanesine karşılık gelen Veri dosyasındaki "K" sütununda bulunan kod bilgilerini aktarmak... Dosyalar ektedir. Yardımlarınızı bekliyorum...
 

Ekli dosyalar

İ

İhsan Tank

Misafir
manly' Alıntı:
Merhaba,

Benim sorunum, iki farklı dosya var. Veri dosyasının "D" sütunundaki verileri, Aktar dosyasının "F" sütununda bulup, "M" sütununda yazan KOD hanesine karşılık gelen Veri dosyasındaki "K" sütununda bulunan kod bilgilerini aktarmak... Dosyalar ektedir. Yardımlarınızı bekliyorum...
Genişletmek için tıkla ...
merhaba
aktar kitabının M2 hücresine
Kod: 
=EĞER(G2="";"";DÜŞEYARA(G2;[veri.xls]SAYFA1!$G$2:$K$65536;5;0))
bu formülü yazıp aşağıya doğru çekiniz
örnek dosya ekte
 

Ekli dosyalar

M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Hocam bunu makro olarak yazabilir miyiz?
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Hocam ünlem işaretlerinde hata verdi..
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod: 
Sub aktar_59()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, k As Range, adr As String
Dim sat As Long
Sheets("SAYFA").Select
Range("M2:M65536").ClearContents
sat = Cells(65536, "F").End(xlUp).Row
If sat < 2 Then Exit Sub
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path _
& "\veri.xls;extended properties=""excel 8.0;hdr=no;imex=1"";"

rs.Open "select F1,F8 from [SAYFA1$D2:K65536];", conn, adOpenKeyset, adLockReadOnly

If rs.RecordCount > 0 Then rs.MoveFirst
Application.ScreenUpdating = False
Do While Not rs.EOF
    Set k = Range("F2:F" & sat).Find(rs(0).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            Cells(k.Row, "M").Value = rs(1).Value
            Set k = Range("F2:F" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
    rs.MoveNext
Loop
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Veriler Aktarıldı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Çok teşekkürler hocam, çok yardımcı oldunuz, ellerinize sağlık....
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Evren Gizlen' Alıntı:
Dosyanız ektedir.:cool:
Kod: 
Sub aktar_59()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, k As Range, adr As String
Dim sat As Long
Sheets("SAYFA").Select
Range("M2:M65536").ClearContents
sat = Cells(65536, "F").End(xlUp).Row
If sat < 2 Then Exit Sub
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path _
& "\veri.xls;extended properties=""excel 8.0;hdr=no;imex=1"";"

rs.Open "select F1,F8 from [SAYFA1$D2:K65536];", conn, adOpenKeyset, adLockReadOnly

If rs.RecordCount > 0 Then rs.MoveFirst
Application.ScreenUpdating = False
Do While Not rs.EOF
    Set k = Range("F2:F" & sat).Find(rs(0).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            Cells(k.Row, "M").Value = rs(1).Value
            Set k = Range("F2:F" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
    rs.MoveNext
Loop
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Veriler Aktarıldı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Genişletmek için tıkla ...

Evren hocam büyük bir dertten kurtardınız beni çok teşekkürler...Bu siteyi çok seviyorum...
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Evren hocam verdiğiniz kodları dosyalarda sütun değişikliği yaparak denemek istedim hata verdi. Bu dosyaları iş yerindeki dosyalarda kullanmak için örnek vermiştim. Gerçek dosyalar orada ama burada yayınlayamam, gizli çünkü...değişiklik yaptığım dosya ve sütunlara göre düzenlediğim kodlar aşağıdaki dosyalarda mevcut.. Ben kodlarda sadece sütunları koda ayarlamak istedim ama olmadı sanırım. Yardımcı olur musunuz? Nerede yanlışlık yaptım.

Bu satırda bir sorun var sanırım...

rs.Open "select F1,F8 from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly
 

Ekli dosyalar

Son düzenleme:
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ne istiyorsunbuz anlamdım.
Bu kodlar ado ile kapalı olan excel dosyasından veri alır.
VBE'de:
tools==>refernce'den microsoft acitivex data object library 2.x seçeneğini seçmelisiniz
ayrıca aşağıdaki kodda dosya yolunu ve adını doğru şekilde yazmalısınız.
Birde bu ado ile bağlantıdaki kodalr 2003 içindir.
2003 üstü için jet yerine ACE
8.0 yerinede 12.0 kullanmalısınız.:cool:
Bu söylediklerim doğrultusunda aşağıdaki kırmızı işaretli yerlere dikat ediniz.:cool:
Kod: 
conn.Open "Provider=microsoft.[B][COLOR="Red"]jet[/COLOR][/B].oledb.4.0;data source=" & [B][COLOR="red"]ThisWorkbook.Path _
& "\veri.xls[/COLOR][/B];extended properties=""excel [B][COLOR="red"]8.0[/COLOR][/B];hdr=no;imex=1"";"
Bu bölümü doğru yazdıktan sonra yine hata oluyorsa
sql cümlesine bakıcaz.(rs.open ile başalıyor.)
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
rs.Open "select F1,F8 from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly


sorun burada
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Evet hocam sorun burada çıkıyor, diğer yerlerde sorun yok...

rs.Open "select F1,F8 from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
manly' Alıntı:
rs.Open "select F1,F8 from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly


sorun burada
Genişletmek için tıkla ...
Evet.Doğru,F1=Field1=Alan1 açılımı budur.
G=F1
H=F2
I=F3
J=F4
K=F5
L=F6
dolayısı ile F8 yok.
şöyle yapın.:
Kod: 
rs.Open "select F1,[B][COLOR="Red"]F6[/COLOR][/B] from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Evren Gizlen' Alıntı:
Evet.Doğru,F1=Field1=Alan1 açılımı budur.
G=F1
H=F2
I=F3
J=F4
K=F5
L=F6
dolayısı ile F8 yok.
şöyle yapın.:
Kod: 
rs.Open "select F1,[B][COLOR="Red"]F6[/COLOR][/B] from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly
Genişletmek için tıkla ...
Tamam hocam şimdi oldu.
Peki hocam,

G=F1 denen yer veri dosyasında, B1 den başlarsa,

B=F1
C=F2
D=F3
E=F4
F=F5
G=F6
H=F7
I=F8
J=F9
K=F10
L=F11 şeklinde olacak ve kod,


rs.Open "select F1,F11 from [SAYFA1$B2:L65536];", conn, adOpenKeyset, adLockReadOnly

şeklinde olması gerekiyor değil mi?
 
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
06.01.2018
Tamam hocam denedim, o şekilde olması gerekiyor...Çok teşekkürler...
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst