Kapalı excel dosyalarından veri çekme

[conari]

Arkadaşlar.
2 farklı belgedeki 3 sayfayı(adları X , Y ve X olsun) farklı bir belgede toplayacağım(adları aynı olacak)
Dış veri al ile bozuk geliyor. (numaralar, başlıklar vs)
Makro ile sitedeki örnekler silinmiş.
Belgeler açılmadan verileri almalıyım.

Örnek dosya eklemedim.
Teşekkürler.

 

[conari]

arkadaşlar yokmu bir yorum.

 

[Korhan Ayhan]

Selamlar,

Örnek dosya eklermisiniz.

 

[conari]

AL-1 ve AL-2 deki
X, Y, Z sayfalarını bu belgeleri açmadan

Toplabuna belgesinde ki
X , Y , Z sayfalarına önceki verileri silerek alacak.

Örnek Ekte

 

[halit3]

aşağıdaki linkdeki 7 nolu sırayı incelermisiniz


http://www.excel.web.tr/f48/kitaplar-aras-veri-aktarma-t65415.html

 

[omerceri]

Veri/Dış Veri Al ile yapılmıştır. C Klasörüne kopyalayın.

 

[conari]

@Ömer ilgine teşekkür ama Dış veri al ile istemiyorum.
Bozuluyor gelen data. Örnektekiler gibi sade değil veriler. Daha kapsamlı daha fazla sütun var.
@Halit'in verdiği linkteki örneğe bakacağım.

 

[halit3]

ben bazı düzenlemeleri yeniden ekledim

 

[conari]

Halit, inceledim ama bunu sadece benim istediğim sayfalara göre uyarlamak lazım. Sayfa isimlerine falan bakmıyor ki bu?

 

[halit3]

yukarıda yeniden düzenlenmiş dosya var yanlızca sarı renkli yerlere sayfa isimlerini yazacaksınız.

 

[Zeki Gürsoy]

Merhaba,

ADO işinizi görebilir sanırım.

set cn = createobject("adodb.connection")
cn.open "Driver={Microsoft Excel Driver (*.xls)};dbq=C:\herhangi.xls"

set rs = createobject("adodb.recordset")

rs.open _
"select * from [Sayfa_adı$] where ...", cn , 1, 3

while not rs.eof
.
.
rs.movenext
wend

rs.close
cn.close

set rs=nothing
set cn=nothing

Kolay gelsin.

 

[conari]

Şimdi biraz daha anlaşıldı. Lakin Hangi sütunları alacağı falan belli değil birde farklı sayfalara almasını istiyorum. adları gibi aynı şekilde. biraz düzenlemeye çalışayım.

 

[conari]

@Halit Bey in örneğini kendime uyarladım fakat satır sayısı 1000 den fazla olacak ileride 4000 e kadar çıkar tek tek hücre bazında alması çok çok yavaş alıyor. Bu bir şekilde memory e alıp ordan paste edemiyor mu?
@Zeki Bey kodunuzu bir iki belge uyarlayarak yayınlarmısınız.

 

[omerceri]

@Ömer ilgine teşekkür ama Dış veri al ile istemiyorum.
Bozuluyor gelen data. Örnektekiler gibi sade değil veriler. Daha kapsamlı daha fazla sütun var.
@Halit'in verdiği linkteki örneğe bakacağım.

Sn Coneri Dış veri alın neyi bozduğunu söylermisiniz. Sütun sayısı önemli değil, Daha kapsamlı derken neyi kasdediyorsunuz.

 

[conari]

Verdiğim örnek döküman.
Dış veri al ile kendi yaptığımda bazı hücrelerdeki bilgiler gelmiyor bazıları geliyor.Ondan ona güvenemiyorum.

 

[Zeki Gürsoy]

'
'
'
'
'


Dosya ektedir..

Sub test()
    Call Veri_Al(ThisWorkbook.Path & "\Al-1.xls", "X")
    Call Veri_Al(ThisWorkbook.Path & "\Al-2.xls", "X")
End Sub

Private Sub Veri_Al(dosya As String, sayfa As String)
Dim cn As Object, rs As Object, f As Object
Dim s1 As Integer, s2 As Long

On Error Resume Next

Set cn = CreateObject("ADODB.Connection")
cn.Open _
    "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & dosya
    
Set rs = cn.Execute( _
"select * from [" & sayfa & "$] ") [COLOR=DarkGreen]'where ...[/COLOR]
      
With Sheets("" & ActiveSheet.Name)
    For Each f In rs.fields
        s1 = s1 + 1
        .Cells(1, s1) = f.Name
    Next
    
    s2 = .[a65000].End(3).Row + 1
    .Cells(s2, "a").CopyFromRecordset rs
End With

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

 

[conari]

@ Zeki Bey hazırladığınız döküman için teşekkürler Fakat buda bir çeşit dış veri al, veriler yine eksik geliyor.
Mesela Y sayfasında H sutunu formüllere göre değer alıyor. Integer veya String bu işlem ile stringler geliyor fakat integer olan değerler yani sayılar gelmiyor.
Bazı sütunlarda da başlıklar gelmiyor.

 

[omerceri]

Sn Conari
Zeki Gürsoy'un kodlarına bazı eklemeler yaptım. Sadece Formül bulunan hücrelerin değerleri geliyor, Başlıklar ve integer değerler geliyor.
Sub test1()
Call Veri_Al(ThisWorkbook.Path & "\Al-1.xls", "X")
Call Veri_Al(ThisWorkbook.Path & "\Al-1.xls", "Y")
Call Veri_Al(ThisWorkbook.Path & "\Al-2.xls", "Z")

End Sub

Private Sub Veri_Al(dosya As String, sayfa As String)
Dim cn As Object, rs As Object, f As Object
Dim s1 As Integer, s2 As Long

On Error Resume Next

Set cn = CreateObject("ADODB.Connection")
cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};DBQ=" & dosya

Set rs = cn.Execute( _
"select * from [" & sayfa & "$] ") 'where ...

With Sheets("" & sayfa)
For Each f In rs.fields
s1 = s1 + 1
.Cells(1, s1) = f.Name
Next

s2 = .[a65000].End(3).Row + 1
.Cells(s2, "a").CopyFromRecordset rs
End With

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

 

[conari]

Maalesef yine gelmiyor.

=EĞER(F7="";"";EĞER(VE(E7>0;D7>0;D7-E7>=0);$N$4;EĞER(VE(E7>0;D7<=0);E7-D7;EĞER(VE(E7=0;D7>0);$N$5;EĞER(D7-E7<0;E7-D7)))))

H sutünuna şu formulu koyun.
N4 N5 de String değerler dönüyor. Diğerleri hesap yapıp integer.
bu sayıların hiçbiri gelmiyor bu yöntem ile.

 

[halit3]

bu dosya verileri birazcık daha hızlı alıyor bir bakınız.
ancak sarı renkli yerlere dosyaların içindeki sayfaların adları yazılması gerekiyor