Excel tablosundan veri aktarma

1 2
08/02/2016, 10:50

balmy

(05/02/2016, 19:25)ozanakkaya yazdı: Sayın balmy, eklediğiniz örnekteki ekleme sorguları düzgün çalışıyor. Bende çözüm olarak bu sorguları ekleyecektim. Sorun nedir acaba? Yapılmasını istediğiniz nedir?

Sayın ozanakkaya öncelikle geç cevap verdiğim için özür dilerim. Hafta sonu bakamadım.
Aslında yukarıda 3 numaralı mesaj da izah etmiştim ama izah edememişim demek ki. 
Ekte Excel tablosunu yeniden düzenledim.Standart tablo ismindeki sayfada  sarı renkli hücrelerde bulunan veriler accesse aktarılırken alan ismi olacak. (Bir.Kul.Mkt(KG), Fire (%), Birim.Kul.Top. Mkt,  Mam.Kul.Top.Mkt  alanlarının satırdan sütuna, üretilen mamul adı,miktar ve birim ise ise sütundan satıra dönüştürülmesi gerekiyor) sorunum bu.
Bu standart tablodaki  satır ve sütun sayıları ; üretilen madde,kullanılan ham maddeye göre değişken. Artabilir de azalabilir de.  Eklediğim örnek standart tablonun gerçeğinde  850 kalem üretilen mamul, 50 kalem de hammadde var 
Excel tablosunda bulunan diğer sayfa  "access bağlı tablo" sunu ben manuel hazırladım.Sorunum anlaşılsın diye.Şimdi siz bu tabloyu yok sayarak,standart tablo da bulunan verilerden sarı hücrelerdeki veriler alan adı olmak kaydıyla accesse aktarırken nasıl bir yöntem uygulardınız ? Siz bizzat bağlı tablo yöntemi ile Excel den veri aktarma işlemini yaptığınızda sanırım konu daha iyi anlaşılmış olacaktır.

iyi çalışmalar
11/02/2016, 02:41

ozanakkaya

Excel belgesini inceledim. Sütun ve satır sayısı fazla olan bir Excel belgesi daha ekleyebilir misiniz?
Satır ve sütun sayısı artınca oluşan tabloyu incelemek lazım.
11/02/2016, 14:01

balmy

(11/02/2016, 02:41)ozanakkaya yazdı: Excel belgesini inceledim. Sütun ve satır sayısı fazla olan bir Excel belgesi daha ekleyebilir misiniz?
Satır ve sütun sayısı artınca oluşan tabloyu incelemek lazım.

Satır ve sütun sayıları fazla olan iki adet Excel dosyası ekledim. Üretilen mamule göre sütun sayısı,kullanılan ham maddeye göre de satır sayısı artabilir veya azalabilir.
iyi çalışmalar 
15/02/2016, 11:43

balmy

Sayın ozanakkaya' nın isteği üzerine Excel tabloları ekte dir.
19/02/2016, 12:20

balmy

Bu konuyu kardeş site olarak gördüğüm başka bir sitede yayınlamıştım. O sitede jon206 kodlu kullanıcı gerekli kodu yazarak problemi halletti.Paylaşmak güzeldir felsefesinden hareketle ve kendisinin izni ile burada yayınlıyorum.
Konuyla ilgilenen tüm arkadaşlara teşekkürler

VBA Kodu

Kod:
Sub VerileriAktarimBasla()
'referanslardan microsoft excel ... object
'referanslardan microsoft activex data object ... library ekli olması gerekir..
'access veri tabanı ile excel dosyası anı klasörde olması gerekir..
'her iki tabloda birkaç değişiklik yaptım inceleyiniz..
 
Dim mRs As New ADODB.Recordset  'M amulmadde tablosu için recordset tanımlıyoruz
Dim hRs As New ADODB.Recordset  'H ammadde tablosu için recordset tanımlıyoruz
Dim xlsapp As New Excel.Application
Dim yol As String, Kul_Hamd As String, str As String
Dim m As Long, x As Long, y As Long
Dim knt As Long, knt2 As Long, Mamul_id As Long, SonSatir As Long
 
'Excel dosyanın Yolu Alıyoruz..
yol = CurrentProject.Path & "\Hesaplama Tablosu.xlsx"
 
'excel dosyasını akra planda yüklüyoruz..
xlsapp.Workbooks.Open yol
 
'excel'i arka planda açıyoruz..
xlsapp.Visible = False
 
'exceldeki yukardan ağaşıya doğru kaç satır olduğunu buluyoruz..
SonSatir = xlsapp.Range("B1048576", Range("B1048576").End(xlUp)).Row + 1
 
m = 4
Do While xlsapp.Cells(3, m) <> "" 'exel 3 satırdan ve m=4 cü kolondan başlamak üzere sağ doğru Mamulmaddeleri döngüye alıyoruz...
 
'tablomuzda aynı kayıt olup olmadığını 0 ve 1 olarak kontrol ediyoruz..
knt = DCount("*", "MAMULMADDE", "[Üretilen Mamul Adı]='" & Cells(3, m) & "' ")
 
If knt = 0 Then 'eğer 0=yok ise mrs.addnew ile yeni kayıt ekliyoruz..
   'Mamulmadde tablomuza yeni kayıt yapmak için tablomuzu açıyoruz..
   mRs.Open "mamulmadde", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
   mRs.AddNew
Else 'kaydımız var ise güncelleme içinn açıyoruz
   Mamul_id = DLookup("id_mamul", "mamulmadde", "[Üretilen Mamul Adı]='" & Cells(3, m) & "' ")
   mRs.Open "select * from mamulmadde where id_mamul=" & Mamul_id, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
End If
   'yeni kayıt ve eski kayıt için ortak alan güncellemesi
   mRs("Üretilen Mamul Adı") = Cells(3, m).Value
   mRs("miktarı") = CLng(Cells(4, m).Value)
   mRs("birimi") = Cells(4, m + 1).Value
 
mRs.Update
Mamul_id = mRs(0) 'id numarasını tekrar alıyoruz.. ' hammadde için
mRs.Close
 
 
'hammede kayıdına geçiyoruz..
'------------------------------------------------
x = 5
y = m
Kul_Hamd = xlsapp.Cells(5, 1) 'kullanılan hammadde verisini alıyoruz 5 satırdaki
Do Until xlsapp.Cells(x, y).Row >= SonSatir
 
If x Mod 4 = 1 Then Kul_Hamd = xlsapp.Cells(x, 1) '5-9-13-17 satırdakikullanılan hammdde alıyoruz..
 
  'mamul edilen ve hammedde eşit olan kaydı kontrol ediyoruz.. yok ise 0 varsa 1 ve üzeri ise güncelleme için
  knt2 = DCount("*", "HAMMADDE", "id_mamul=" & Mamul_id & " and [kullanılan hammadde]='" & Kul_Hamd & "'")
 
If knt2 = 0 Then 'yok ise
   hRs.Open "hammadde", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
   hRs.AddNew 'yeni kayıt ekle diyoruz..
   hRs("id_mamul") = Mamul_id
   hRs("üretilen mamul adı") = xlsapp.Cells(3, m)
   hRs("kullanılan hammadde") = Kul_Hamd
   hRs("bir#kul#mkt(kg)") = xlsapp.Cells(x, y) '1
   x = x + 1
   hRs("fire (%)") = xlsapp.Cells(x, y) '2
   x = x + 1
   hRs("birim#kul#top#mkt") = xlsapp.Cells(x, y) '3
   x = x + 1
   hRs("mam#kul#top#mkt") = xlsapp.Cells(x, y) ' 4
 
   hRs.Update
   hRs.Close
   Set hRs = Nothing
Else 'eski kayıt varsa güncelleme için ise
   hRs.Open "select * from hammadde where id_mamul=" & Mamul_id & " and [kullanılan hammadde]='" & Kul_Hamd & "'", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
   hRs("bir#kul#mkt(kg)") = xlsapp.Cells(x, y) '1
   x = x + 1
   hRs("fire (%)") = xlsapp.Cells(x, y) '2
   x = x + 1
   hRs("birim#kul#top#mkt") = xlsapp.Cells(x, y) '3
   x = x + 1
   hRs("mam#kul#top#mkt") = xlsapp.Cells(x, y) ' 4
   hRs.Update
   hRs.Close
   Set hRs = Nothing
End If
x = x + 1
Loop
'---------- hammadde verilerin bitişi ----------------------------------------------------------
 
m = m + 3 'sonraki mamul mal geçmek için M değeri +3 ekliyoruz sebebi örng: 3 satırın d-e-f kolonlarını dikkate alırsak (E ve F) kolonun boş olmasıdır..
Loop
 
'excel dosyasını kapatıyoruz..
xlsapp.Workbooks.Close
xlsapp.Quit
Set mRs = Nothing
Set hRs = Nothing
MsgBox "Aktarım Tamamlanmıştır.."
End Sub
1 2