• DİKKAT

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

CopyFromRecordset (metin,sayı)

Katılım
24 Kasım 2007
Mesajlar
769
Excel Vers. ve Dili
Office 365 - Türkçe
Merhaba

Kapalı dosyada ;
A dosyasının AAA isimli sayfanın B4:L100 aralığını
B dosyasının BBB isimli sayfasının B4 hücresinden itibaren yapıştırmak istiyorum

Verileri çekmede sorunum yok, fakat sadece metin olan "F" sütunu geliyor. Sayılar ile birlikte metin, yani komple o alanı nasıl çekebilirim. Büyük ihtimalle metin, sayı uyuşmazlığı var

Dosyalarım ektedir
 

Ekli dosyalar

A dosyasındaki tüm alanların biçimini Genel yaparsınız çözülür.
 
Murat bey teşekkür ediyorum. Dediğiniz değişik ile sonuç aldım

Burada paylaştığım dosyalar örnek dosyalardı. İşin açıkçası "A" dosyasının benzeri olan, (yani örnek olmayan) gerçek dosyanın içeriği ile ben oynayamıyorum. Ancak dosyayı salt okunur açabiliyorum. O yüzden bu işi kodlar üzerinden yapmamız zormudur
 
Dosya yolunu kendinize göre düzenlersiniz..
Kod:
[SIZE="2"]Sub hat()
    Dim ac As Workbook, dosya As String
    Application.ScreenUpdating = False
    dosya = ThisWorkbook.Path & "\A.xlsx"
    Set ac = Workbooks.Open(dosya)
    Sheets(1).Cells.NumberFormat = "General"
    ac.Close True
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RECORDSET")
    conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & _
    ";extended properties=""excel 12.0;hdr=no;imex=1"";"
    rs.Open "select * from [AAA$B4:L100];", conn, 1, 1
    Sheets("BBB").Range("B4").CopyFromRecordset rs
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Application.ScreenUpdating = True
End Sub[/SIZE]
 
Murat bey çok teşekkür ederim

Sheets(1) dediğiniz
"A" dosyası içindeki 1.nolu sheet değil mi ? Çekilecek veriler başka bir sheette ise o shettin numarasını belirtmemem gerekiyor, doğrumudur ?
 
Evet aynen öyle.
İlk sayfada olacağını düşündüm, o sebeple 1 yazdım.
Siz ayarlarsınız artık.
Sabit bir sayfa ise direkt ismini de yazabilirsiniz.
 
Murat bey orijinal dosyamda deneyince malesef olmadı

Çünkü verilerin çekildiği dosya anlık açıldığı için "salt okunur açınız" uyarısı alıyorum
orayı da geçtim, verilerin formatları değiştikten sonra, dosya kapatılırken kaydet devreye giriyor

verilerin çekildiği dosyayı açtırmamam lazım
 
ScreenUpdating'den önce veya sonra Application.DisplayAlerts = False ekleyin. Aynı şekilde en alta da True olanı yazarsınız.
 
Denedim maalesef olmadı. Ana dosya kapanırken "ac.Close True" kayıt yeri istiyor

IMEX=0,1,2 Olaylarını da baktım
Normalde IMEX = 1'de karışık veri tiplerini (metin, sayı) alıyordu diye biliyorum, ama olmadı

Şeyde olabilir, sayı olan sütunları ayrı, metin olan sütunları ayrıda alabilirim, tek bir veri aralığı değilde, her veri tipi için ayrı veri aralığı gibi
 
Orijinal dosyayı yollarsanız yardımcı olmaya çalışırım.
 
Şöyle bir deneyin.. Yolu sizinki ile değiştirirsiniz.

Kod:
[SIZE="2"]Sub hat()
    Dim ac As Workbook, dosya As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    dosya = ThisWorkbook.Path & "\A.xlsx"
    Set ac = Workbooks.Open(dosya)
    Sheets(1).Cells.NumberFormat = "General"
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RECORDSET")
    conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & _
    ";extended properties=""excel 12.0;hdr=no;imex=1"";"
    rs.Open "select * from [AAA$B4:L100];", conn, 1, 1
    ThisWorkbook.Sheets("BBB").Range("B4").CopyFromRecordset rs
    rs.Close
    conn.Close
    ac.Close False
    Set rs = Nothing
    Set conn = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub[/SIZE]
 
Murat bey orijinal dosyalarım ektedir

100-MPM dosyasının
"5" isimli sheetinin B50:L1000 arasını veri dosyasına çekeceğim

Çok zamanınızı almaz ise, incelerseniz memnun olurum. ben beceremedim
 

Ekli dosyalar

Murat bey orijinal dosyalarım ektedir

100-MPM dosyasının
"5" isimli sheetinin B50:L1000 arasını veri dosyasına çekeceğim

Çok zamanınızı almaz ise, incelerseniz memnun olurum. ben beceremedim


Referanslar bölümünde aşağıdaki olmalı kırmızı bölüm değişebilir.

Kod:
Microsoft Activex Data Objects [COLOR="Red"]2[/COLOR] Library

KOD:
Kod:
Sub deneme()

dosya = ThisWorkbook.Path & "\100-MPM.xlsm"

Dim Kayit As ADODB.Recordset
Set Kayit = New ADODB.Recordset

Sayfa_adı = "5"

baglan = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "SELECT * FROM [" & Sayfa_adı & "$B50:L100];", baglan, adOpenKeyset, adLockOptimistic

 
If Kayit.RecordCount > 0 Then
Range("B4").CopyFromRecordset Kayit

End If


Kayit.Close
Set Kayit = Nothing

Set fL = Nothing
End Sub
 
halit bey ;
veri çekmede sorun yaşamıyorum. benim sorun yaşadığım kısım, ana dosyadan çekilen verilerin biçimlerinden dolayı (sayı, metin) sadece metin verilerini alabiliyorum. Ana dosyanın hücre biçimlerine de dokunamıyorum.

Bana ; sayı, metin ayrımı olmadan, veya sayı verileri ayrı, metin verileri ayrı gelebilecek şekilde, bir şey lazım, lakin o birşeyi bulamıyorum
 
halit bey ;
veri çekmede sorun yaşamıyorum. benim sorun yaşadığım kısım, ana dosyadan çekilen verilerin biçimlerinden dolayı (sayı, metin) sadece metin verilerini alabiliyorum. Ana dosyanın hücre biçimlerine de dokunamıyorum.

Bana ; sayı, metin ayrımı olmadan, veya sayı verileri ayrı, metin verileri ayrı gelebilecek şekilde, bir şey lazım, lakin o birşeyi bulamıyorum

birde bunu dene

Kod:
Sub veri_al()
klasor = ThisWorkbook.Path
dosya = "100-MPM.xlsm"
SayfaAdi = "5"
deg = "'" & klasor & "\[" & dosya & "]" & SayfaAdi & "'!R"

sat = 4

For r = 50 To 1000
For t = 2 To 12
Cells(sat, t).Value = ExecuteExcel4Macro(deg & r & "C" & t)  'kapalı dosyadaki değerlere ait prosüdür
Next t
sat = sat + 1
Next r

End Sub
 
Halit bey teşekkür ediyorum. Kod çalışıyor. Her ne kadar (Application.ScreenUpdating = False eklememe rağmen) çok yavaş olsada işimi görecek. Yalnız kodda anlamadığım bir yer var

ExecuteExcel4Macro(deg & r & "C" & t)

ExecuteExcel4Macro = prosedür başlığı mı ? ExecuteExcel3Macro yazarsam ne olur ?
deg = yol
r = döngü
"C" = anlamadım ?
t = döngü
 
Son düzenleme:
Murat Beyin yazdığı kodlar gayet güzel çalışıyor.

Sizin eklediğiniz dosya benim bilgisayarımda salt okunur olarak açılıyor dosyanın fiziki durumu bozuk dosya salt okunur uyarısı vererek açılıyor bu dosyayı bir defa açın ve farklı kayıt ederek yeniden oluşturun sonra oluşturduğunuz dosyadan veriler alınacaktır.
 
VBA ve ADO ile 9-10 yıldır uğraşıyorum. Her platformda anlatmaya çalışıyorum ama 10 yılda pek bir şey değişmiyor.

Veritabanı oluştururken SQL,Oracle,MySQL gibi veritabanı programlarında hatta MS Access programında bile sütun tipini belirler ve o tipe göre veri girmek zoruda kalırsınız.

Excel doğrudan bir veritabanı uygulaması olmadığı halde veritabanı olarak kullanıyoruz. Gerçek bir veritabanı uygulaması olmaması nedeniyle olması gereken kriterlere dikkat etmiyoruz.

Bir veritabanı oluşturacaksak her sütunda tek tip veri olmalıdır. Ad Soyad kısmında sayı yazmamalısınız.. Sayı olması gereken yerlere metin eklememelisiniz. 11 sayıdır 11A ise metindir. Bunlar aynı sütunda olmamalıdır.

ADO veritabanı programlarını klasik T-SQL komutlarını kullanır. Tanımlanan veriyi düzgün ve kurallara uygun girilmiş olarak kabul eder. Eğer veri düzensiz ise ADO size IMEX=1 seçeneğini sunmaktan başka bir şey yapmaz. BU şekilde alfanumeric karakter olarak işlem yaptırır ama sayısal verilerde sıkıntı yaşamaya devam edersiniz.
 
aynı sorunu bende yaşıyorum veriyi çekeceğim dosyada sayı ve metin var malum bunları çeken bir kod bulamadım :( çözümü yok sanırım
 
Böyle durumlarda ben dosyayı arka planda gizli olarak açarak verileri alıyorum. Gayet pratik oluyor.

Forumda aşağıdaki ifadeler ile arama yapabilirsiniz.

CreateObject("Excel.Application")
GetObject
 
Geri
Üst