AccessTr.neT

Bul · 18/01/2020, 00:48

aşağıdaki kod bende çalıştı dilerim işinize yarar
Açılır kutu accessten farklıymış
ComboBox1.Column = ADO_RS.GetRows kodu ile alıyormuş

Dim Sql As String

Dim ADO_CN As Object

Dim ADO_RS As Object



Set ADO_CN = CreateObject("Adodb.Connection")

Set ADO_RS = CreateObject("adodb.recordset")



SQL = "SELECT F1 as HY1, F2 as Hy2 "

SQL = Sql & vbCrLf

SQL = Sql & "FROM [Sayfa1$f11:g15" & "] ORDER BY F1 ;"



ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""

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.movelast

ADO_RS.MoveFirst

 

 ComboBox1.Column = ADO_RS.GetRows



ADO_RS.Close

ADO_CN.Close

Set ADO_RS = Nothing

Set ADO_CN = Nothing

bu arada sağolun @feraz hocam dediğiniz gibi referans eklemeden yaptım)

Bul · 18/01/2020, 01:21

(18/01/2020, 00:50)berduş yazdı: bu arada sağolun @feraz hocam dediğiniz gibi referans eklemeden yaptım)

Rica ederim üstad.
En kullanışlısı zaten referans eklemeden yapma.

Kullanışlı derken başkaları kodları kopyala yapıştırınca hata vermez.

Bul · 18/01/2020, 01:43

(18/01/2020, 00:48)berduş yazdı: aşağıdaki kod bende çalıştı dilerim işinize yarar
Açılır kutu accessten farklıymış
ComboBox1.Column = ADO_RS.GetRows kodu ile alıyormuş

Dim Sql As String

Dim ADO_CN As Object

Dim ADO_RS As Object



Set ADO_CN = CreateObject("Adodb.Connection")

Set ADO_RS = CreateObject("adodb.recordset")



SQL = "SELECT F1 as HY1, F2 as Hy2 "

SQL = Sql & vbCrLf

SQL = Sql & "FROM [Sayfa1$f11:g15" & "] ORDER BY F1 ;"



ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""

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.movelast

ADO_RS.MoveFirst

 

 ComboBox1.Column = ADO_RS.GetRows



ADO_RS.Close

ADO_CN.Close

Set ADO_RS = Nothing

Set ADO_CN = Nothing

SQL = Sql & "FROM [Sayfa1$f11:g" & sonsatırno & "]" ORDER BY F1 " böylede sonsatır no değişken eklerseniz böyle olur.

Bul · 18/01/2020, 02:23

Bublesort arşivimden ekleyeyim dictionary de var.
3 adet dosya var deneyebilirsiniz istiyorsanız.
Dosyayı buraya yükleyemedim çünkü dosya ekleme yeri çıkmadı birtürlü.

https://www.dosyaupload.com/70l4

Kod:

For i = 1 To say

        For j = i To say

            If arr(i, 1) > arr(j, 1) Then

                Temp = arr(j, 1)

                arr(j, 1) = arr(i, 1)

              arr(i, 1) = Temp

            End If

        Next j

    Next i

Yukarıdaki yer bublesort kısım.Çok fazla benzersiz veri varsa yazaş çalışır.

Kod:

Private Sub CommandButton1_Click()



    Dim i As Long, j As Long, k As Long

    Dim Temp As Long

    Dim scr As Object

    Dim say As Long, arr()

    

    List = Range("A3:A" & Cells(Rows.Count, 1).End(3).Row).Value

    

    Set scr = CreateObject("Scripting.Dictionary")

    

With scr

ReDim arr(1 To UBound(List), 1 To 1)

    On Error Resume Next

    For k = LBound(List) To UBound(List)

      If Not .Exists(List(k, 1)) Then

        .Add List(k, 1), ""

            say = say + 1



        arr(say, 1) = List(k, 1)



      End If

    Next

    

    [D:D] = ""

    Err.Clear

If say > 0 Then

    For i = 1 To say

        For j = i To say

            If arr(i, 1) > arr(j, 1) Then

                Temp = arr(j, 1)

                arr(j, 1) = arr(i, 1)

              arr(i, 1) = Temp

            End If

        Next j

    Next i

  



  Range("D3").Resize(say, 1).Value = arr

End If

  

End With



    MsgBox "Bitti..", vbInformation

    

  Erase List: Set scr = Nothing: Erase arr

End Sub

Bul · 18/01/2020, 07:43

Paylaşımlar için teşekkürler
Arşiv bende yapmaya çalıştım bir müddet sonra içine herşeyi attığım aradığımı bulamadığım garip bir hal alıyor orada aramaktansa google da daha yenisini daha kısa sürede bular hale geliyorum
Ben java da sql ile çalışırken genel olarak vertabanı bilgilerini arraylist hashmap gibi dizelere alıp işlem yapıyorum daha kısa sürüyor gerektiğinde dizileri güncelliyorum excelde her seferinde recordset ile almak siralamak filtrelemek uzun sürüyor mu

Bul · 18/01/2020, 13:21

(18/01/2020, 07:43)accessman yazdı: Paylaşımlar için teşekkürler
Arşiv bende yapmaya çalıştım bir müddet sonra içine herşeyi attığım aradığımı bulamadığım garip bir hal alıyor orada aramaktansa google da daha yenisini daha kısa sürede bular hale geliyorum
Ben java da sql ile çalışırken genel olarak vertabanı bilgilerini arraylist hashmap gibi dizelere alıp işlem yapıyorum daha kısa sürüyor gerektiğinde dizileri güncelliyorum excelde her seferinde recordset ile almak siralamak filtrelemek uzun sürüyor mu

Arraylist olayı exceldede var.

System.collection.arraylist vba olarak aratırsanız hertürlü örnek var.

Bubblesortu şu yönden seviyorum.
Arraylist ve Ado ile bazen sıralanırken garip sıralanıyor.

AccessTr.neT

Excel İstediğimiz Sayfanın İstediğimiz Sutundan Sıralı Filtreli Gruplanmış Liste

Excel İstediğimiz Sayfanın İstediğimiz Sutundan Sıralı Filtreli Gruplanmış Liste

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Giriş yap

Hesap oluştur

Konu Linkleri