Soru Yenilenen Değerleri Kopyalama ve Sayma

[okan32]

ARKADAŞLAR F SÜTUNUNDA YAKLAŞIK 3500 ADET VERİ VAR. YAPMAK İSTEDİĞİM F SÜTUNUNDAKİ YENİLENEN DEĞERLERİ H5 TEN İTİBAREN H SÜTUNUNA KOPYALAMAK VE I SÜTUNUNADA YENİLENEN DEĞERLERİN KAÇ ADET OLDUĞUNU YAZDIRMAK İSTİYORUM. YARDIMLARINIZ İÇİN ŞİMDİDEN TEŞEKKÜRLER

 

[YUSUF44]

Bunun için Özet tablo kullanmayı denediniz mi? En basit, en doğru ve en hızlı çözümdür.

 

[okan32]

Bunun için Özet tablo kullanmayı denediniz mi? En basit, en doğru ve en hızlı çözümdür.

Denemedim Hocam ama kod olursa benim için daha iyi olacak

 

[YUSUF44]

Aşağıdaki makroyu deneyin ama ben özet tabloda ısrarcıyım:

Sub ozet()
son = Cells(Rows.Count, "F").End(3).Row
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select distinct F1 from [1$F5:F" & son & "] where f1 is not null"
Set rs = con.Execute(sorgu)
Range("H5:I" & Rows.Count).ClearContents
[H5].CopyFromRecordset rs
sonH = Cells(Rows.Count, "H").End(3).Row
For i = 5 To sonH
    Cells(i, "I") = WorksheetFunction.CountIf(Range("F5:F" & son), Cells(i, "H"))
Next

sorgu = "select distinct F1,F2 from [1$H5:I" & sonH & "] where F2>1"
Set rs = con.Execute(sorgu)
Range("H5:I" & Rows.Count).ClearContents
[H5].CopyFromRecordset rs
End Sub

 

[okan32]

Aşağıdaki makroyu deneyin ama ben özet tabloda ısrarcıyım:

Sub ozet()
son = Cells(Rows.Count, "F").End(3).Row
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select distinct F1 from [1$F5:F" & son & "] where f1 is not null"
Set rs = con.Execute(sorgu)
Range("H5:I" & Rows.Count).ClearContents
[H5].CopyFromRecordset rs
sonH = Cells(Rows.Count, "H").End(3).Row
For i = 5 To sonH
    Cells(i, "I") = WorksheetFunction.CountIf(Range("F5:F" & son), Cells(i, "H"))
Next

sorgu = "select distinct F1,F2 from [1$H5:I" & sonH & "] where F2>1"
Set rs = con.Execute(sorgu)
Range("H5:I" & Rows.Count).ClearContents
[H5].CopyFromRecordset rs
End Sub

Çok Teşekkür ederim Yusuf Hocam Özet tabloyu tam bilmiyorum ama en kısa zamanda öğrenmeye çalışacağım

 

[YUSUF44]

Bu vesileyle yapamadığım bir şeyi @Haluk , @Korhan Ayhan, @Necdet , @Muzaffer Ali üstadlarıma sorayım:

Aslında

sorgu = "select distinct F1, counta(F1) from [1$F5:F" & son & "] where f1 is not null"

ya da

sorgu = "select distinct F1, count(F1) from [1$F5:F" & son & "] where f1 is not null"

ya da

sorgu = "select distinct F1, counta(F1) as adet from [1$F5:F" & son & "] where adet>1"

satırıyla kayıtların sayısını da bulmak istedim ama "Automation Error" hatası verdi. Bu nedenle önce sorgu sonra döngüyle kayıt sayıları sonra da yine sorgu kullanmak zorunda kaldım.

Bunu tek sorguyla nasıl yapabiliriz?

 

[Haluk]

Yusuf Bey;

Sub ozetHD()
    Dim objConn As Object, strSQL As String, objRS As Object
    
    Range("H5:I" & Rows.Count).ClearContents
    
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open "Provider=MICROSOFT.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR= No'"
    
    strSQL = "Select F1, Count(F1) From [1$F5:F] Where F1 Is Not Null Group By F1"
    
    Set objRS = objConn.Execute(strSQL)
        
    [H5].CopyFromRecordset objRS
    
    objRS.Close
    Set objRS = Nothing
    objConn.Close
    Set objConn = Nothing
End Sub

.

 

[Korhan Ayhan]

Alternatif;

Sub Tekrarlanan_Veriler()
    Dim My_Connection As Object, My_Recordset As Object, Zaman As Double
 
    Zaman = Timer
  
    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=No"""
     
    Set My_Recordset = My_Connection.Execute("Select F1, Count(F1) From [1$F5:F] Group By F1 Having Count(F1) > 1")
  
    Range("H5:I" & Rows.Count).Clear
    Range("H5").CopyFromRecordset My_Recordset
  
    If My_Connection.State <> 0 Then My_Connection.Close
  
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
  
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[YUSUF44]

Teşekkürler üstadım. Anladığım kadarıyla group by kullanılması gerekiyor öyle mi?

Peki sayısı 1'den fazla olanlar olarak nasıl düzenlememiz gerekir?

sorgu = "Select F1, Count(F1) From [1$F5:F] Where count(F1)>1 Group By F1"

ve

sorgu = "Select F1, Count(F1) as adet From [1$F5:F] Where adet>1 Group By F1"

ve belki de sorun başlık kullanılmasıdır diye düşünüp

ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "Select KONUSU, Count(KONUSU) as adet From [1$F4:F] Where adet>1 Group By KONUSU"

sorgu = "Select KONUSU, Count(KONUSU) as adet From [1$F4:F] Where Count(KONUSU)>1 Group By KONUSU"

şekillerinde denedim ama sonuç alamadım.

Ek: @Korhan Ayhan üstadım göstermiş. Teşekkürler üstadım.