Çözüldü Veri Kıyaslama ve Aktarma,

[gicimi]

Merhaba;

Sayfa 2 ye "Malzeme No" bilgilerini tarihe göre sıralaması ve "Malzeme Adı " "MM" ve "MZ" olanları Sayfa2 ye Diğer Sütunlardaki bilgiler ile birlikte aktarmasını istiyorum. Verinin fazla olmasından dolayı makro konusunda yardımlarınızı bekliyoruz.

 

[Haluk]

Veri setindeki tüm malzeme adları "MM" veya "MZ" . O zaman bu iş için makroya gerek yok ki ..... verileri kopyalayıp, öbür sayfaya yapıştırın. Sonra "Data" sekmesinde sıralama işini belirttiğiniz 2 kritere göre yapın.

.

 

[gicimi]

@Haluk hocam hem öğrenme amaçlı hemde daha sonra farklı sayfalardanda veri getirmek için makro ile yapmak istiyorum.

 

[Haluk]

Anlıyorum ...

Dediğim işi manuel yaparken makro kaydet yöntemini kullanırsanız, gerekli kodları üretmiş olursunuz. Onları inceleyebilirsiniz.

Başka bir alternatif de ADO-SQL kullanmak olabilir, bununla ilgili kod ise aşağıdadır...

Sub Test()
    'Haluk - 12/11/2018
    Dim objConnection As Object
    Dim strConnection As String
    Dim strQuery As String
    Dim RS As Object
    
    Sheets("Sayfa2").Range("A2:G" & Rows.Count) = ""
    
    Set objConnection = CreateObject("ADODB.Connection")
    
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "User ID=Admin;" & _
                    "Data Source='" & ThisWorkbook.FullName & "';" & _
                    "Mode=Read;" & _
                    "Extended Properties=""Excel 12.0 Macro;"";"

    strQuery = "Select * from [Sayfa1$] " & _
               "where [Malzeme Adı] = 'MM' or [Malzeme Adı] = 'MZ' order by [Tarih], [Malzeme No] asc"
    
    objConnection.Open strConnection
    Set RS = objConnection.Execute(strQuery)
    
    Sheets("Sayfa2").Range("A2").CopyFromRecordset RS
    
    objConnection.Close
    Set RS = Nothing
    Set objConnection = Nothing
End Sub

 

[gicimi]

@Haluk Bey teşekkür ederim. Kolaylıklar.

 

[gicimi]

@Haluk Hocam bilgilendirmeyi eksik yapmışım. Malzeme No aynı olan ve MM - MZ Malzeme Adı olanları sadece aktarmasını istiyorum. Kusura bakmayın. Kodu günceller misiniz.

 

[Haluk]

Aşağıdaki kodun ürettiği tablo, size aradıklarınızı bulmanızda kolaylık sağlayacaktır.

Sub Test2()
    'Haluk - 13/11/2018
    Dim objConnection As Object
    Dim strConnection As String
    Dim strQuery As String
    Dim RS As Object
    
    Sheets("Sayfa2").Range("A2:G" & Rows.Count) = ""
    
    Set objConnection = CreateObject("ADODB.Connection")
    
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source='" & ThisWorkbook.FullName & "';" & _
                    "Extended Properties=""Excel 12.0 Macro;"";"

    strQuery = "Select * from [Sayfa1$] " & _
               "where [Malzeme No] in " & _
               "( " & _
               "select [Malzeme No] from [Sayfa1$] group by [Malzeme No] having count([Malzeme No]) > 1" & _
               ") " & _
               "and ([Malzeme Adı]='MM' or [Malzeme Adı]='MZ')"
    
    objConnection.Open strConnection
    Set RS = objConnection.Execute(strQuery)
    
    Sheets("Sayfa2").Range("A2").CopyFromRecordset RS
    
    objConnection.Close
    Set RS = Nothing
    Set objConnection = Nothing
End Sub

.

 

[gicimi]

@Haluk Bey teşekkürler.