• DİKKAT

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

Alan adları değişiyorsa

merakli_72

merakli_72

Katılım
24 Temmuz 2007
Mesajlar
726
Excel Vers. ve Dili
Excel 2010 tr
mrb,
Ado ile bir excel kitabından aşağıdaki gibi veri çekiliyor,
fakat ilgili sayfadaki sutun baslıkları sürekli değişebiliyorsa sorgu nasıl yazılabliri
Teşekkürler

Sub Excel_Baglan()



Dim cn As Object, rs As Object
Dim i As Byte, son As Long, arr()


Cells.Clear
Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
"C:\Documents and Settings\xxxyyy\desktop" & "\" & "Yeni Ciro Tablosu.xls"

Set rs = cn.Execute( _
"SELECT [A] FROM [cirohedef$A1:f65536] ")


Sheets("sayfa3").[A1].CopyFromRecordset rs

rs.Close
cn.Close


Set rs = Nothing
Set cn = Nothing

End Sub
 
Aşağıdaki gibi başlık adı yerine sütun sıralamasını dikkate alarak işlem yapabilirsiniz.

Kod: 
[COLOR=#ff0000]"SELECT F1 FROM [cirohedef$A1:f65536] ")
[/COLOR]

Not: F1 birinci sütunu ifade eder. İkinci sütun için F2, üçüncü sütun için F3 şeklinde ardışık giden bir sırayla diğer sütunları tanımlayabilirsiniz.
 
Levent Menteşoğlu' Alıntı:
Aşağıdaki gibi başlık adı yerine sütun sıralamasını dikkate alarak işlem yapabilirsiniz.

Kod: 
[COLOR=#ff0000]"SELECT F1 FROM [cirohedef$A1:f65536] ")
[/COLOR]

Not: F1 birinci sütunu ifade eder. İkinci sütun için F2, üçüncü sütun için F3 şeklinde ardışık giden bir sırayla diğer sütunları tanımlayabilirsiniz.
Genişletmek için tıkla ...
Levent bey sanırım sütun başlıklarını alan adı olarak değilde Sütun adlarını kullanıyor.Bu durumda connectionstringte hdr = yes mi ,yoksa no mu olmalıdır?
Birde F1 sanırım Field1 Manasına mı geliyor?
 
Merhaba Levent bey,
"SELECT F1 FROM [cirohedef$A1:f65536] ")
şeklinde olmadı ama( Çok az parametre 1.bakleniyor diyor) ek olarak başka birşeylerdemi yazmak gerekiyor acaba
Connection string değişecekse nasıl yazmak gerekir acaba
 
Aşağıdaki connectionstringte hdr= kelimesine yes ve no olarak 2 ayrı şekilde denermisiniz.:cool:
cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
"C:\Documents and Settings\xxxyyy\desktop" & "\" & "Yeni Ciro Tablosu.xls;hdr=Yes;"

veya
"Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
"C:\Documents and Settings\xxxyyy\desktop" & "\" & "Yeni Ciro Tablosu.xls;hdr=No;"
 
Evren bey merhaba,
2 şekildede aynı hatayı veriyor
fakat hdr=Yes te yapsanız hdr=no'da yapsanız sorguyu
select * ...
değiştirdiğinizde sutun başlıkları gelmiyor,
hdr kullanımı ile ilgili bir sorun olabilirmi
 
merakli_72' Alıntı:
Evren bey merhaba,
2 şekildede aynı hatayı veriyor
fakat hdr=Yes te yapsanız hdr=no'da yapsanız sorguyu
select * ...
değiştirdiğinizde sutun başlıkları gelmiyor,
hdr kullanımı ile ilgili bir sorun olabilirmi
Genişletmek için tıkla ...
Siz tüm alanlarımı çekmek istyorsunuz,yoksa sadece ilk alanımı çekmek istiyorsunuz?
 
Ben bir kaç alanı çekmek istiyorum
A sutundaki sutun baslıkları değiştiğindende Select deyiminden sonra baslığı yazamıyorum

Yukarıda verdiğim örnekte select * ... şeklinde yazmam hdr'nin işe yarayıp yaramadığını anlayabilmek içindi
Umarım açıklayabilmişimdir.
Saygılarımla
 
Örnek dosyaları eklermisiniz.
hem vt yi hemde hedef dosyayı
 
Sanırım levent beyin kodunu kullanmak için ado ya sayfa sütun başlıklarının kullanışlacağını bildirmek gerekiyor.
Bunu ona sorarız.
Ben aşağıdaki döngü yöntemi ile sorunu çözdüm.Tabiiki ilk yönteme göre biraz daha yavaş çalışıyorr.Ama bunu farkedemezsiniz bile.
vt lerde sütun başlıklarında aralarında boşluk bırakmayınız.alt altatada yamayınız sade yazınız.:cool:
Şimdilik ben düzelttim.
Referanslardan microsoft acitivex 2.8 data object library eklendi
1nci ve 3ncü sütundaki verileri alıyor.
Dosyanız ektedir.:cool:
Kod: 
Sub Excel_Baglan()
'Referanslardan microsoft acitivex 2.8 data object library eklendi


Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim i As Integer, son As Long, arr(), sat As Long
 
    
        Cells.Clear
        Application.ScreenUpdating = False
        Set cn = New ADODB.Connection
        Set rs = New ADODB.Recordset
        cn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _
        "\vt.xls;extended properties=""Excel 8.0;hdr=yes"""
        '"Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
                'ThisWorkbook.Path & "\" & "vt.xls;hdr=yes;"
        
        rs.Open "SELECT  * FROM [cirohedef$A1:C65536];", cn, adOpenKeyset, adLockReadOnly
        rs.MoveFirst
        Do While Not rs.EOF
            sat = sat + 1
            Cells(sat, "A").Value = rs(0).Value
            Cells(sat, "B").Value = rs(2).Value
            rs.MoveNext
        Loop
        rs.Close
        cn.Close
    
 
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
MsgBox "Kaynak dosyadan 1nci ve 3ncü sütundaki veriler akatarıldı" _
& vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 

Ekli dosyalar

Bu daha hızlı çalışıyor.
Yine döngü var ama verileri direk hücreye yazmayıp dizi ye aldım.
Diziden bir seferde sayfaya yazdım.Böyle ilk yöntem kadar hızlı çalıştı.:cool.
vt lerde sütun başlıklarında aralarında boşluk bırakmayınız.alt altatada yamayınız sade yazınız.:cool:
Şimdilik ben düzelttim.
Kod: 
Sub Excel_Baglan2()
'Referanslardan microsoft acitivex 2.8 data object library eklendi


Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim i As Integer, son As Long, arr(), sat As Long
Dim myarr()
    
        Cells.Clear
        Application.ScreenUpdating = False
        Set cn = New ADODB.Connection
        Set rs = New ADODB.Recordset
        cn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _
        "\vt.xls;extended properties=""Excel 8.0;hdr=yes"""
        '"Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
                'ThisWorkbook.Path & "\" & "vt.xls;hdr=yes;"
        
        rs.Open "SELECT  * FROM [cirohedef$A1:C65536];", cn, adOpenKeyset, adLockReadOnly
        ReDim myarr(1 To rs.RecordCount, 1 To 2)
        rs.MoveFirst
        Do While Not rs.EOF
            sat = sat + 1
            myarr(sat, 1) = rs(0).Value
            myarr(sat, 2) = rs(2).Value
            rs.MoveNext
        Loop
        rs.Close
        cn.Close
    
 
Set rs = Nothing
Set cn = Nothing
Sheets("Sayfa3").Range("A1").Resize(sat, 2) = myarr
Application.ScreenUpdating = True
MsgBox "Kaynak dosyadan 1nci ve 3ncü sütundaki veriler akatarıldı" _
& vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 

Ekli dosyalar

vt lerde sütun başlıklarında aralarında boşluk bırakmayınız.alt altatada yamayınız sade yazınız
vt veritabanı değil aslında, başka bir amaç için kullanılan tablo, zaman zaman bu tablodaki veriler başka bir amaç için kullanılan bu kitabada lazım olduğundan ordan veri çekmek için düşündüm,

Söylede bir durum var, vt'da A1 deki başlığı silerseniz
msgbox rs(0).Name dediğinizde F1 sonucunu donduruyor
ama sorguyu
Select F1 ... şeklinde yazdığınızda hata veriyor
Sanırım Levent beyin sorguyu select F1,F2 From ...
şeklinde yazın öneriside burdan geldi, birşeyler eksik gibi ama ney
 
Ekli hedef isimli dosyanızdaki prosedürü aşağıdaki ile değiştirerek deneyin.

Kod: 
Sub Excel_Baglan()
Dim cn As Object, rs As Object
Dim i As Byte, son As Long, arr()
 
 
        Cells.Clear
        Set cn = CreateObject("ADODB.Connection")
 
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\vt.xls" & _
        ";Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"
        Set rs = cn.Execute( _
        "SELECT F1,F2,F3 FROM [cirohedef$A2:f65536] ")
 
 
        Sheets("sayfa3").[A1].CopyFromRecordset rs
 
        rs.Close
        cn.Close
 
 
Set rs = Nothing
Set cn = Nothing
 
End Sub

Not: İlk mesajımda F1 ifadesini ilk sütun adı olarak belirtmiştim. Ancak bunu ilk alan adı olarak tanımlamak doğru olandır.
 
Evet şimdi oldu
Teşekkürler Levent ve Evren Bey
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst