Tekrarlanan veriler

[orcunkurtar]

Merhabalar

R2 sayfasındaki g sutunünda isimler var ( revire gelenlerin listesi )ben R3 sayfasındaki grafiğin alt kısmına revire en çok gelen 5 kişinin ID ismini birim ve görevini yazdırmak istiyorum konu hakkında yardımcı olabilir misiniz dosya linki

 

[orcunkurtar]

Merhaba yardımcı olabilecek var mı ?

 

[mancubus]

Sub xlTR_193052_top5_list()
'VBE / Tools / References / Microsoft ActiveX Data Objects x.x Library işaretlenmeli

    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
    Dim fName As String, strSQL As String
    Dim j As Integer
   
    fName = ThisWorkbook.FullName
   
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")

    strSQL = "SELECT q.*, t.[AD SOYAD], t.[GÖREV], t.[BİRİM] FROM (SELECT TOP 5 [ID NO], COUNT([ID NO]) AS Adet FROM [R2$] GROUP BY [ID NO] ORDER BY COUNT([ID NO]) DESC)  AS q LEFT JOIN [R2$] AS t ON q.[ID NO] =  t.[ID NO];"

    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly

    With Worksheets("R3")
        For j = 1 To rs.Fields.Count
            .Cells(32, 7 + j).Value = rs.Fields(j - 1).Name 'fields koleksiyonu base 0 olduğu ve j 1'den başladığı için -1
        Next j
        .Range("H33").CopyFromRecordset rs
    End With
       
    rs.Close
    cn.Close

End Sub

 

[orcunkurtar]

Merhaba

Çok teşekkür ederim .

Microsoft ActiveX Data Objects 6,1 Library sectım
ama automation hatası alıyorum .

 

[mancubus]

Rica ederim.
ben 2.8 ve 6.1 ayrı ayrı denedim. ikisinde de çalıştı.

Automation error'ün bir çok nedeni olabiliyor. özellikle network dosyalarında çalışırken.
VBE'de F8 ile satır satır ilerleyip hangi satırda hata verdiğini söyleyebilir misiniz?
O şekilde araştıralım.

 

[mancubus]

veya referanssız aşağıdaki şekilde de denemek mümkün.

Sub xlTR_193052_top5_list_v2()

    With CreateObject("ADODB.Recordset")
        .Open "SELECT q.*, t.[AD SOYAD], t.[GÖREV], t.[BİRİM] FROM (SELECT TOP 5 [ID NO], COUNT([ID NO]) AS Adet FROM [R2$] GROUP BY [ID NO] ORDER BY COUNT([ID NO]) DESC) AS q LEFT JOIN [R2$] AS t ON q.[ID NO] =  t.[ID NO];", _
        ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
        Worksheets("R3").Range("H32").CopyFromRecordset .DataSource
    End With

End Sub

 

[orcunkurtar]

2. yide denedim
.Open "SELECT q.*, t.[AD SOYAD], t.[GÖREV], t.[BİRİM] FROM (SELECT TOP 5 [ID NO], COUNT([ID NO]) AS Adet FROM [R2$] GROUP BY [ID NO] ORDER BY COUNT([ID NO]) DESC) AS q LEFT JOIN [R2$] AS t ON q.[ID NO] = t.[ID NO];", _
("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")

bu satırda hata veriyor bu kes hem automatıon hatası hemde unspesified hatası vermekte

 

[mancubus]

ikinci kodu da benim pc'de (iş yeri) sorunsuz çalıştığını gördükten sonra atmıştım.

R2 sayfasındaki sütun başlıkları yüklediğiniz dosyadaki gibi mi?
arada boşluklu ID NO ve AD SOYAD şeklinde mi?
bir buna bakın.

bir de network folder'ında çalışıyorsanız dosyayı bilgisayarın sabit diskine kopyalayarak deneyin.
aklıma gelen diğer husus ise başka bir pc'de denemek.

 

[orcunkurtar]

valla sizi uğrastırdım kusura bakmayın biraz daha deneyeceğim belki farklı bir yöntem yaparım çok teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak yardımcı sütun kullanarak ürettiğim çözümü deneyebilirsiniz.

Öncelikle R2 sayfasında X2 hücresine aşağıdaki formülü uygulayınız. Ben 10.000 satırlık bir veri için tasarladım. Siz kendinize göre formüldeki 10000 değerlerini değiştirip kullanabilirsiniz. Sonra bu formülü ihtiyacınız kadar alt hücrelere sürükleyiniz.

=EĞER(EĞERSAY($F$1:F2;F2)=1;EĞERSAY($F$2:$F$10000;F2)+SATIR(A2)/10000;"")

Bu formül size büyüklük indexi oluşturacaktır.

Daha sonra R3 sayfasında H33 hücresine aşağıdaki formülü uygulayınız. Formülü aşağı ve sağa doğru sürükleyiniz. Formül içindeki >5 değeri ile oynayarak listeyi genişletip-daraltabilirsiniz.

=EĞER(SATIRSAY($H$33:$H33)>5;"";EĞERHATA(İNDİS('R2'!$A$2:$WE$10000;KAÇINCI(BÜYÜK('R2'!$X$2:$X$10000;SATIR(A1));'R2'!$X$2:$X$10000;0);SÜTUN(F$1));""))

 

[mancubus]

esatağfurullah. umarım ihtiyacınız çözülür.

 

[orcunkurtar]

Çok teşekkür ederim