Dün yada önceki gün excelden recordset ile veri alma sorusu sorulmuştu sitemizde ondaki mantığı yada sayin @feraz in son sorusunda kullandığı kod 2si de ise yarar bence. Recordset ile baglarken kullanılan Sql kodlarında distinct yada order by eklenebilir bence. Denemedim ama mantıklı gibi geliyor
Excel İstediğimiz Sayfanın İstediğimiz Sutundan Sıralı Filtreli Gruplanmış Liste
Excelde sayfadan bilgileri Sql ile alabiliyor muyuz userformda kullanmak için
Şimdiye kadar denemedim recordseti yeni kullanmaya başladım excelden accesse tablosayfa almak için. Ama excelden excele henuz denemedim. Belki de olmuyordur)
sSql = "select * from [Sayfa1$]" bu kodda sayfa ve belli bir hücre aralığı seçilebilir
Ayrıca Sql kodu olduğu için filtreleme için where, sıralama için order by, tekrarı engellemek için group by yada distinct kullanılabiliyor. Ama excelde denemedim
Ayrıca Sql kodu olduğu için filtreleme için where, sıralama için order by, tekrarı engellemek için group by yada distinct kullanılabiliyor. Ama excelde denemedim
(16/01/2020, 18:54)berduş yazdı: resimdeki isimlendirmeleri kullandım, tüm alanları metin olarak ayarladım
dilerim işinize yarar
iyi çalışmalar
Not : Çalışmanıza referans eklemeniz gerekebilir
txtDosyaAdres = "D:\AKTAR.xlsx" ' Buraya dosya adresi ve adı yazılacak
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String, sConn2 As String
Dim degerler, sSql As String
degerler = ""
sSql = "select * from [Sayfa1$]" '
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & txtDosyaAdres
sConn2 = ";Extended Properties=""Excel 12.0 Xml;HDR=No"";"
Set con = New ADODB.Connection
con.Open sConn & sConn2
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open sSql, con, adOpenKeyset 'rather use this so RecordCount works
If rs.RecordCount = 0 Then Exit Sub
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF = True
degerler = degerler & ", '" & rs.Fields(0) & "'"
rs.MoveNext
Loop
degerler = Mid(degerler, 2)
sSql = " insert into [Veriler1] (kimlikNo, ad, soyAd, babaAd) " & _
" values (" & degerler & ")"
CurrentDb.Execute sSql
Set rs = Nothing
Ben hiç Sql Excel sayfasından veri alır diye düşünmemiştim
Önüme yeni bir kapı açtınız
Oyun hamuru gibi oynarım Excel ile artık
Önüme yeni bir kapı açtınız
Oyun hamuru gibi oynarım Excel ile artık
Mesela şu kodu incelemekle başlayalım
Kod:
Kod:
Kod:
Private Sub UserForm_Initialize()
Dim SQL As String
Dim BasTarih As Long, BitTarih As Long
Dim VTSonSatir As Long
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
Dim ToplamTutar As Double
'
ToplamTutar = 0
VTSonSatir = Sheets("DetayVeri").Cells(1048576, 8).End(xlUp).Row
BasTarih = Cells(1, Selection.Column)
BitTarih = Cells(2, Selection.Column)
SQL = "SELECT TARIH, NAKIT_AKIS_KODU, HESAP_KODU, HESAP_ADI, ACIKLAMA, Doviz_TL, Doviz_USD, Doviz_EURO "
SQL = SQL & vbCrLf
SQL = SQL & "FROM [DetayVeri$E10:AH" & VTSonSatir & "] "
SQL = SQL & vbCrLf
SQL = SQL & "WHERE SUBE_UNVAN = '" & Cells(Selection.Row, 11) & "' "
SQL = SQL & "AND RaporGrupKodu = '" & Cells(Selection.Row, 12) & "' "
SQL = SQL & "AND YilAyGun Between " & BasTarih & " AND " & BitTarih & " "
SQL = SQL & vbCrLf
SQL = SQL & "ORDER BY TARIH "
Cells(1, 1) = SQL
'
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
Exit Sub
End If
ADO_RS.MoveFirst
Do While Not ADO_RS.EOF
Lst_Detay.AddItem
' Lst_Detay.Column(0, Lst_Detay.ListCount - 1) = ADO_RS.Fields("Departman").Value
' Lst_Detay.Column(1, Lst_Detay.ListCount - 1) = ADO_RS.Fields("MuhasebeHesapNo").Value
' Lst_Detay.Column(2, Lst_Detay.ListCount - 1) = Format(ADO_RS.Fields("FullTarih").Value, "DD/MM/YYYY")
' Lst_Detay.Column(3, Lst_Detay.ListCount - 1) = ADO_RS.Fields("FisNo").Value
' Lst_Detay.Column(4, Lst_Detay.ListCount - 1) = ADO_RS.Fields("Aciklama").Value
' Lst_Detay.Column(5, Lst_Detay.ListCount - 1) = Format(ADO_RS.Fields("Tutar_TL").Value, "#,###.00")
' ToplamTutar = ToplamTutar + ADO_RS.Fields("Tutar_TL").Value
ADO_RS.MoveNext
Loop
Lst_Detay.TextAlign = fmTextAlignRight
Txt_KayitSayisi.Text = ADO_RS.RecordCount
Txt_ToplamTutar.Text = Format(ToplamTutar, "#,###.00")
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
'
'Lst_Detay.Height = 445
DoEvents
End Sub
Konuyu Okuyanlar: 1 Ziyaretçi
