Soru verileri özetleme

[incsoft]

Arkadaşlar A sütünunda A1 den A20 ye kadar olan alana veriler girilmekte ancak 20 satırda bazen 2 isim olabildiği gibi bazen 10 isimde olabiliyor. A1'den A20'ye kadar olan verileri A25 A36 aralığına nasıl özet hale getirebilirim? Veriler yukarı girdikçe kendisi aşağı özetleyecek yapabilirse isime göre de sıralayacak. Bu konuda yardımlarınıza ihtiyacım vardır.

Teşekkürler..

 

[Korhan Ayhan]

ÖZET TABLO ile çok kolay bir şekilde yapabilirsiniz.

 

[incsoft]

ÖZET TABLO ile çok kolay bir şekilde yapabilirsiniz.

Onu 1 defa yapmayacağım için o şekilde yapmak istemiyorum Korhan bey. Her gün kullanacağım bir dosyada bu özelliği kullanacam ve kullanacak kişilerde özet tablo,pivot table bilgilerine de sahip değiller. Veriler girildikçe otomatik aşağıda özetlemesini ve sıralamasını istiyorum macro ile olursa...

 

[Korhan Ayhan]

Aslında ÖZET TABLO excel bilgisi zayıf olan kişiler için biçilmiş kaftandır. Neyse bu konuda çok ısrarcı olmayacağım.

Aşağıdaki kodu boş bir modüle uygulayınız.

Option Explicit

Sub Unique_Sorted_List()
    Dim My_Connection As Object, My_Recordset As Object, My_Query As String
   
    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"""

    My_Query = "Select Distinct * From [Sayfa1$A1:A20] Where Not IsNull(F1)"
   
    Set My_Recordset = My_Connection.Execute(My_Query)
 
    Range("A25:A44").ClearContents
    Range("A25").CopyFromRecordset My_Recordset
  
    If My_Connection.State <> 0 Then My_Connection.Close

    Set My_Recordset = Nothing
    Set My_Connection = Nothing
End Sub

Sonrasında sayfanızın kod bölümüne ise aşağıdaki kodu ekleyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A20")) Is Nothing Then Exit Sub
    Call Module1.Unique_Sorted_List
End Sub

Bundan sonra A1:A20 aralığında bir değişiklik olduğunda listeniz yenilenecektir.

 

[incsoft]

Aslında ÖZET TABLO excel bilgisi zayıf olan kişiler için biçilmiş kaftandır. Neyse bu konuda çok ısrarcı olmayacağım.

Aşağıdaki kodu boş bir modüle uygulayınız.

Option Explicit

Sub Unique_Sorted_List()
    Dim My_Connection As Object, My_Recordset As Object, My_Query As String
  
    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"""

    My_Query = "Select Distinct * From [Sayfa1$A1:A20] Where Not IsNull(F1)"
  
    Set My_Recordset = My_Connection.Execute(My_Query)

    Range("A25:A44").ClearContents
    Range("A25").CopyFromRecordset My_Recordset
 
    If My_Connection.State <> 0 Then My_Connection.Close

    Set My_Recordset = Nothing
    Set My_Connection = Nothing
End Sub

Sonrasında sayfanızın kod bölümüne ise aşağıdaki kodu ekleyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A20")) Is Nothing Then Exit Sub
    Call Module1.Unique_Sorted_List
End Sub

Bundan sonra A1:A20 aralığında bir değişiklik olduğunda listeniz yenilenecektir.

Öncelikle çok teşekkürler hocam. Ne kadar denediysem orjinal dosyama adapte edemedim maalesef.. =B3:B22 arasını =B24:B34 özetleme yaparak toplam adetini ve sayısını aldırmak istiyorum. Mümkünse bunu ekteki dosyaya adapte etme imkanımız varmıdır?

Teşekkürler..

 

[Korhan Ayhan]

Hangi kısmını uyarlayamadınız?