Formülün VBA koda çevrilmesi

endexci · 26 Ekim 2022

Merhabalar,

Excelde A ve B sütunlarımda değerler var, aşağıdaki formül ile benzersizleri saydırıyorum fazla veri olmayınca sorun yok çalışıyor formüller, fakat 50 bin satırda kasma yaptırıyor. Formülümü VBA koduna çevirmek istedim kasmadan benzersizleri saydırması için, fakat yapamadım konu ile ilgili yardımcı olur musunuz yada yazdığım formülde hata mı var değerli görüşlerinizi sabırsızlıkla bekliyorum. Şimdiden teşekkür ederim.

TOPLA(EĞER(SIKLIK(EĞER((Sayfa1!$B$2:$B$66141<>"")*(Sayfa1!$A$2:$A$66141=Sayfa1!$A8);KAÇINCI("~"&Sayfa1!$B$2:$B$66141;Sayfa1!$B$2:$B$66141&"";0));SATIR(Sayfa1!$B$2:$B$66141)-SATIR($B$2)+1);1))

veyselemre · 26 Ekim 2022

Formülün ne işe yaradığını bilmiyorum. Ama aşağıdaki kod sipariş numarasına göre, farklı ürünleri sayar.

Kod:

Sub test()
    Dim veri, i&, ky, kys, rng As Range, krt

    With Sheets("Sayfa1")
        Set rng = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row)
        veri = rng.Value
    End With

    With CreateObject("Scripting.Dictionary")
        
        For i = 1 To UBound(veri)
            .Item(veri(i, 1) & "|" & veri(i, 2)) = Null
        Next i
        
        kys = .keys
        .RemoveAll
        
        For Each ky In kys
            krt = Val(Split(ky, "|")(0))
            .Item(krt) = .Item(krt) + 1
        Next
        
        For i = 1 To UBound(veri)
            veri(i, 3) = .Item(veri(i, 1))
        Next i
        
        rng.Value = veri
        
    End With

End Sub

endexci · 26 Ekim 2022

veyselemre' Alıntı:

Formülün ne işe yaradığını bilmiyorum. Ama aşağıdaki kod sipariş numarasına göre, farklı ürünleri sayar.

Kod:

Sub test()
    Dim veri, i&, ky, kys, rng As Range, krt

    With Sheets("Sayfa1")
        Set rng = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row)
        veri = rng.Value
    End With

    With CreateObject("Scripting.Dictionary")
       
        For i = 1 To UBound(veri)
            .Item(veri(i, 1) & "|" & veri(i, 2)) = Null
        Next i
       
        kys = .keys
        .RemoveAll
       
        For Each ky In kys
            krt = Val(Split(ky, "|")(0))
            .Item(krt) = .Item(krt) + 1
        Next
       
        For i = 1 To UBound(veri)
            veri(i, 3) = .Item(veri(i, 1))
        Next i
       
        rng.Value = veri
       
    End With

End Sub

Çok teşekkür ederim ALLAH razı olsun tam istediğim gibi çalıştı

Korhan Ayhan · 26 Ekim 2022

Alternatif,

ADO uygulaması...

C++:

Option Explicit

Sub Benzersiz_Say_Ado()
    Dim My_Connection As Object, My_Recordset As Object, Process_Time As Double
    
    Process_Time = Timer
    
    Application.ScreenUpdating = False
    
    Range("C2:C" & Rows.Count).ClearContents
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
 
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
     
    Set My_Recordset = My_Connection.Execute("Select Tablo_2.Adet From " & _
                                             "[Sayfa1$] As Tablo_1 Left Join " & _
                                             "(Select [Sipariş Numarası],Count([Sipariş Numarası]) As Adet From " & _
                                             "(Select Distinct [Sipariş Numarası],[Ürün Adı] From [Sayfa1$]) " & _
                                             "Group By [Sipariş Numarası]) As Tablo_2 " & _
                                             "On Tablo_1.[Sipariş Numarası] = Tablo_2.[Sipariş Numarası]")

    If Not My_Recordset.EOF Then Range("C2").CopyFromRecordset My_Recordset

    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
  
    Set My_Connection = Nothing
    Set My_Recordset = Nothing

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
End Sub

tamer42 · 27 Ekim 2022

Korhan Ayhan' Alıntı:

Alternatif,

ADO uygulaması...

C++:

Option Explicit

Sub Benzersiz_Say_Ado()
    Dim My_Connection As Object, My_Recordset As Object, Process_Time As Double
   
    Process_Time = Timer
   
    Application.ScreenUpdating = False
   
    Range("C2:C" & Rows.Count).ClearContents
   
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")

    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    Set My_Recordset = My_Connection.Execute("Select Tablo_2.Adet From " & _
                                             "[Sayfa1$] As Tablo_1 Left Join " & _
                                             "[B](Select [Sipariş Numarası],Count([Sipariş Numarası]) As Adet From " & _
                                             "(Select Distinct [Sipariş Numarası],[Ürün Adı] From [Sayfa1$]) " & _
                                             "Group By [Sipariş Numarası])[/B] As Tablo_2 " & _
                                             "On Tablo_1.[Sipariş Numarası] = Tablo_2.[Sipariş Numarası]")

    If Not My_Recordset.EOF Then Range("C2").CopyFromRecordset My_Recordset

    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
 
    Set My_Connection = Nothing
    Set My_Recordset = Nothing

    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
End Sub

Korhan Hocam merhaba,
Burada vermiş olduğunuz ADO uygulamasıyla ilgili bir şey sormak istiyorum? ne derece olabilir, işin doğrusu merka ediyorum.

görüleceği üzere sorgu içinde sorgu mevcut; Ana sorgunun içindeki yardımcı sorguyu öncesinde farklı bir Recorset Kayıt Kümesi içine alsak;

strSQL= (Select [Sipariş Numarası],Count([Sipariş Numarası]) As Adet From " & _
"(Select Distinct [Sipariş Numarası],[Ürün Adı] From [Sayfa1$]) " & _
"Group By [Sipariş Numarası])

Set My_RS = My_Connection.Execute(strSQL)

yada;

My_RS.open strSQL, My_Connection

sonra bu My_RS Kayıt Kümesi içinden sorgulatmak mümkün olur mu?
Bazen bu kayıtları sayfaya yazdırdıktan sonra devam ediyorum, sayfaya yazdırmdadan kestirmeden mümkün olur mu diye düşündüm.

teşekkürler, iyi Çalışmalar.

Korhan Ayhan · 27 Ekim 2022

Merhaba Tamer Bey,

Benim bildiğim SubQuery (Alt Sorgu) ile olabildiğidir. Ya da sizin belirttiğiniz gibi sorgu sonucunu sayfaya yazdırıp oradan diğer sorguları yürüterek sonuca gidilebilir.

Belki ilk sorgu sonucu diziye alınarak sonuca gidilebilir. Bu konuda tecrübeli üyelerimiz bizleri yönlendirebilirler.

tamer42 · 2 Kasım 2022

Korhan Ayhan' Alıntı:
Merhaba Tamer Bey,

Benim bildiğim SubQuery (Alt Sorgu) ile olabildiğidir. Ya da sizin belirttiğiniz gibi sorgu sonucunu sayfaya yazdırıp oradan diğer sorguları yürüterek sonuca gidilebilir.

Belki ilk sorgu sonucu diziye alınarak sonuca gidilebilir. Bu konuda tecrübeli üyelerimiz bizleri yönlendirebilirler.

hOR

Korhan Ayhan' Alıntı:
Alternatif,

ADO uygulaması...

Korhan Hocam merhaba,
buradaki koddan esinlerek ekli dosyada yer aldığı şekilde bir kod hazırladım, yalnız hata verdi.
burada nasıl bir yol takip edilebilir?

Kod:

     strSQL3 = "Select [Kod],[Adet] From [Sayfa3$]"
     
    strSQL = "Select Tablo_3.[Adet] From " & _
               "[Sayfa2$] As Tablo_2 Left Join " & strSQL3 & " As Tablo_3 " & _
                   "On Tablo_2.[Kod] = Tablo_3.[Kod]"

                                             
         Set My_Recordset = My_Connection.Execute(strSQL)

şimdiden teşekkürker,
iyi Çalışmalar.

Korhan Ayhan · 2 Kasım 2022

Alt sorgu parantez içinde olmalıdır.

strSQL3 = "(Select [Kod],[Adet] From [Sayfa3$])"

tamer42 · 2 Kasım 2022

Korhan Ayhan' Alıntı:
Alt sorgu parantez içinde olmalıdır.

strSQL3 = "(Select [Kod],[Adet] From [Sayfa3$])"

Korhan hocam teşekkürler,
aslında parantez içine almak aklıma da gelmişti,

Konuyu bir adım ileriye taşımak istersek;
Sayfa1 de yer alan şehir bilgisinin karşında Sayfa2' de bir Kod var.
Sayfa2 de yer alan kod bilgisinin karşında Sayfa3' de bir Adet var.
Şehir >>> Kod >>> Adet
Sayfa1' de Şehir başlayarak Sayfa3' deki Adet bilgisine ulaşmayı düşünüyordum, Bunun için aşağıdaki sorgu düzenini oluşturdum buraya kadar sıkıntı yok;
Öğrenmeye çalıştığım Sayfa1 farklı bir dosya (Hedef) , Sayfa2 ve Sayfa3 farklı bir dosyada (Kaynak) olursa;

Hedef.xlsm dosyasından Kaynak.xls dosyasına ulaşıp aynı şekilde Adet verilerine ulaşmak için sorguyu nasıl düzenleyebiliriz?

Not: Her iki dosyada aynı klasör altında;

Kod:

        strSQL2 = "(Select Tablo_2.[Kod] From " & _
               "[Sayfa1$] As Tablo_1 Left Join [Sayfa2$] As Tablo_2 " & _
                   "On Tablo_1.[Şehir] = Tablo_2.[Şehir])"

     strSQL3 = "(Select [Kod],[Adet] From [Sayfa3$])"
     
    strSQL = "Select Tablo_3.[Adet] From " & _
               strSQL2 & " As Tablo_2 Left Join " & strSQL3 & " As Tablo_3 " & _
                   "On Tablo_2.[Kod] = Tablo_3.[Kod]"
                      
         Set My_Recordset = My_Connection.Execute(strSQL)

ilginize tekrar teşekkürler,
iyi akşamlar.

Korhan Ayhan · 2 Kasım 2022

Bu linkte örnekler var. Sanırım kendinize uyarlayabilirsiniz.

Soru - Düşeyara (VBA ile Dış Kaynaktan)

Değerli üstadlar; Excel içinde düşeyara gerek formülle, gerek makro ile yapabilmekteyim. Merak ettiğim VBA yolu ile "Hedef Excel" e "Kaynak Excel" den düşeyara ile veri çektirebilir miyiz?

www.excel.web.tr

Formülün VBA koda çevrilmesi

endexci

Ekli dosyalar

veyselemre

Özel Üye

endexci

Korhan Ayhan

Administrator

tamer42

Destek Ekibi

Korhan Ayhan

Administrator

tamer42

Destek Ekibi

Ekli dosyalar

Korhan Ayhan

Administrator

tamer42

Destek Ekibi

Ekli dosyalar

Korhan Ayhan

Administrator

Soru - Düşeyara (VBA ile Dış Kaynaktan)