• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan manly
  • Başlangıç tarihi Başlangıç tarihi
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
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

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

Hocam bunu makro olarak yazabilir miyiz?
 
Hocam ünlem işaretlerinde hata verdi..
 
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

Çok teşekkürler hocam, çok yardımcı oldunuz, ellerinize sağlık....
 
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...
 
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:
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.)
 
rs.Open "select F1,F8 from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly


sorun burada
 
Evet hocam sorun burada çıkıyor, diğer yerlerde sorun yok...

rs.Open "select F1,F8 from [SAYFA1$G2:L65536];", conn, adOpenKeyset, adLockReadOnly
 
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
 
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?
 
Tamam hocam denedim, o şekilde olması gerekiyor...Çok teşekkürler...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst