Alan1 e excelden veri kopyalama

[k0081]

Merhaba arkadaşlar;

Alan1 e excel tablomda bulunan H sütunundaki verileri nasıl kopyalayabilirim ?

Yardımcı arkadaşa şimdiden teşekkürler..

 

[Murat OSMA]

Yapmak istediğinizi örnekleyiniz.

 

[k0081]

Yapmak istediğinizi örnekleyiniz.

Hocam şöyle ki;

Excelde deki tablomda H2:H1200 arasında veriler var.

H2= 12,36
H3= 14,32
H4= 15,60
...
...
H1200 = 17,40

gibi... şimdi bu hücreleri seçip Kopyala ( CTRL+C ) dediğimde, Access dosyamdaki "Profiller" tablosu içinde bulunan Alan1 alanına beli bir satırdan itibaren Yapıştırmak.. ( CTRL+V). Yada Alan1 e exceldeki H2:H1200 aralığındaki verileri çekmek...

 

[halit3]

Aslında örnek dosya eklemeyenlere ben cevap vermiyorum.
Çünkü yazı dilinde anlatılan örnek dosya ile uyumlu olmadığını bir çok kez gördüm.
Buradan anladığım Profiller sayfasında Alan1 Sütununa veri aktarmak.
Aşağıdak kodun kırmızı yerlerini kendinize göre doldurun.

kod:

Sub veri_aktar()

a = MsgBox("  Bu kayıtı yapmak istiyormusunuz. ", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If


[COLOR="Red"]Dosya = "C:\Documents and Settings\Administrator\Desktop\bbb\deneme.mdb"
Sayfa_adı = "Profiller"
Tablo_adi = "Alan1"
Uzanti = "mdb"[/COLOR]

Dim Kayit As ADODB.Recordset
Set Kayit = CreateObject("adodb.recordset")
'sifre = "1234"
If Uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "mdb" Then
baglan = "provider=microsoft.jet.oledb.4.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
ElseIf Uzanti = "accdb" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
Else

Exit Sub
End If


For i = 2 To Cells(Rows.Count, "h").End(3).Row
Kayit.AddNew
Kayit([COLOR="red"]"Alan1"[/COLOR]) = Cells(i, "h").Value
Next i

Kayit.Update
Kayit.Close


MsgBox "kayıt işlemi tamamdır"
Set Kayit = Nothing

End Sub

 

[k0081]

halit3

Haklısınız hocam. bundan sonraki sorularımda örnek dosya eklemeye çalışacağım..

verdiğiniz kodları ekledim ve düzenledim.. fakat bir hata iletisi alıyorum.. hata iletisini ve ornek dosyaları bir link e ekledim.

http://s3.dosya.tc/server21/RxuJAU/ornek.rar.html

 

[halit3]

halit3

Haklısınız hocam. bundan sonraki sorularımda örnek dosya eklemeye çalışacağım..

verdiğiniz kodları ekledim ve düzenledim.. fakat bir hata iletisi alıyorum.. hata iletisini ve ornek dosyaları bir link e ekledim.

http://s3.dosya.tc/server21/RxuJAU/ornek.rar.html

Şimdi sorduğunuz soru ile gönderdiğiniz dosya çok çok farklı
isimler farklı ikiden fazla alan ismi var bu durumda tabiki kodlarınız çalışmayacaktır.

Ben veri dosyanızı aynı ortamda yeniden düzenledim.
Ayrıca referens kontröllerinizde eksik.

Kodlar buradaki dosyada çalışıyor muhtemelen sizin dosyanızda çalışmıyacaktır.

kod:

Private Sub CommandButton1_Click()


a = MsgBox("  Bu kayıtı yapmak istiyormusunuz. ", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If

[COLOR="Red"]Dosya = "C:\Documents and Settings\Administrator\Desktop\Ebatlar.mdb"
Sayfa_adı = "profiller"
Tablo_adi = "prfID, prfname, h, b, s, t, r1, r2, fs, metrekg"
Uzanti = "mdb"
[/COLOR]
Dim Kayit As ADODB.Recordset
Set Kayit = CreateObject("adodb.recordset")

'sifre = "1234"
If Uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "mdb" Then
baglan = "provider=microsoft.jet.oledb.4.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
ElseIf Uzanti = "accdb" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
Else

Exit Sub
End If

For j = 2 To Cells(Rows.Count, "h").End(3).Row
Kayit.AddNew
Kayit(0) = Kayit.RecordCount + 1
For i = 1 To Kayit.Fields.Count - 1
If i = 1 Then
Kayit(i) = Cells(j, "h").Value
Else
Kayit(i) = ""
End If
Next i
Next j

Kayit.Update
Kayit.Close

MsgBox "kayıt işlemi tamamdır"
Set Kayit = Nothing

End Sub

 

[k0081]

halit3

Hocam; örnek2.rar dosyasını başka bir linke eklemeniz mümkü mü ? yeni kodlarıda ekledim yine aynı durum. bir de referans kontroller bunları nasıl ayarlamalıyım..? <-- Sanırım problem bu kısımdan kaynaklanıyor..

 

[halit3]

halit3

Hocam; örnek2.rar dosyasını başka bir linke eklemeniz mümkü mü ? yeni kodlarıda ekledim yine aynı durum. bir de referans kontroller bunları nasıl ayarlamalıyım..? <-- Sanırım problem bu kısımdan kaynaklanıyor..

Bendeki referenslar böyle

Visual Basic For Applications
Microsoft Excel 12.0 Object Library
OLE Automation
Microsoft Office 12.0 Object Library
Microsoft Forms 2.0 Object Library
Microsoft ActiveX Data Objects 2.0 Library
Microsoft ADO Ext. 2.8 for DDL and Security
Microsoft DAO 3.6 Object Library

 

[k0081]

halit3

Halit hocam, sizdeki gibi referansları işaretledim. bende Ofis 2010 x64 yüklü.. şuan bir ilerleme kaydettim. sizin mesajınız geliyor.. "Bu kayıtı yapmak istiyormusunuz".. akabinde aşağıdaki linkte verdiğim hatayı alıyorum.

Debug dediğimde :

Kayit.Open "select * from " & sayfa_adı, baglan, 3, 2

bu kısımda duruyor.

http://www.dosya.tc/server28/vfLxTX/2014-04-21_132839.jpg.html
********************************************************************

Hocam tamamdır.. çalıştırdım.. çok teşekkür ediyorum. Emeğinize sağlık, saygılar..

 

[halit3]

görsel video

Görsel video ekledim.
kod:

Private Sub CommandButton1_Click()


a = MsgBox("  Bu kayıtı yapmak istiyormusunuz. ", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If

Dosya = "C:\Documents and Settings\Administrator\Desktop\Ebatlar.mdb"

Sayfa_adı = "profiller"
Uzanti = "mdb"

Dim Kayit As ADODB.Recordset
Set Kayit = CreateObject("adodb.recordset")

If Uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "SELECT * FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then
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ı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "mdb" Then
baglan = "provider=microsoft.jet.oledb.4.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
ElseIf Uzanti = "accdb" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
Else

Exit Sub
End If


For j = 1 To Cells(Rows.Count, "h").End(3).Row
Kayit.AddNew
Kayit(0) = Kayit.RecordCount + 1
For i = 1 To Kayit.Fields.Count - 1
If i = 1 Then
Kayit(i) = Cells(j, "h").Value
Else
Kayit(i) = ""
End If
Next i
Next j

Kayit.Update
Kayit.Close

MsgBox "kayıt işlemi tamamdır"
Set Kayit = Nothing

End Sub

 

[k0081]

halit3

Hocam video için çok teşekkür ederim. küçük bir ekleme yapma şansımız var mıdır. ? şimdi exceldeki kayıtları prfname alanına kayıt ediyoruz.. bu tamam.

Kodlarda ; Prfname yi bir değişkene bağlayabilirmiyiz..?

Mesela : Alansecimi=prfname gibi.. ben burdan gerektiğinde Alansecimi değişkenini ayalayabileyim.. kodları inceledim ama prfname yi değiştirecek kısmı
bulamadım..

örnekleme :

Alansecimi=Prfname
Alansecimi=b
Alansecimi=h

bunlardan biri gibi...

Not: kodlarda her zaman sadece bir Alan secimi ayarlanmış olmalı.

 

[halit3]

halit3

Hocam video için çok teşekkür ederim. küçük bir ekleme yapma şansımız var mıdır. ? şimdi exceldeki kayıtları prfname alanına kayıt ediyoruz.. bu tamam.

Kodlarda ; Prfname yi bir değişkene bağlayabilirmiyiz..?

Mesela : Alansecimi=prfname gibi.. ben burdan gerektiğinde Alansecimi değişkenini ayalayabileyim.. kodları inceledim ama prfname yi değiştirecek kısmı
bulamadım..

örnekleme :

Alansecimi=Prfname
Alansecimi=b
Alansecimi=h

bunlardan biri gibi...

Not: kodlarda her zaman sadece bir Alan secimi ayarlanmış olmalı.

Ben sizin 1 nolu mesajınıza cevap verdim Access veri taban ile aram iyi değil benden bu kadar.
Size iyi çalışmalar

 

[k0081]

halit3

Tamam hocam, çok teşekkür ediyorum yardımlarınız için.. sağolun. saygılar.

***** Bu soru çözümlenmiştir.. *******