Aynı Verileri Otomatik Birleştirme Hk.

[adromov]

Merhaba,

Ekteki dosyada yer alan Sayfa1 deki verilerin, Sayfa 2 de otomatik olarak birleşmesini istiyorum.

Konuyla ilgili bilgi sahibi olan var ise yardımcı olabilir mi

Şimdiden çok teşekkür ederim.

 

[Murat OSMA]

Bu şekilde size kimse yardımcı olamaz.
Şu an dosyanızda bir şeyler olabilmesi için birinin okus pokus demesi gerekir.

Ne istediğinizi net olarak ifade etmezseniz yardım alamazsınız.
Sayfa2'deki veriler olmasını istediğiniz hâli mi?

 

[adromov]

Bu şekilde size kimse yardımcı olamaz.
Şu an dosyanızda bir şeyler olabilmesi için birinin okus pokus demesi gerekir.

Ne istediğinizi net olarak ifade etmezseniz yardım alamazsınız.
Sayfa2'deki veriler olmasını istediğiniz hâli mi?

Merhaba Kusura bakmayın Murat Bey,

Tam ifade edemedim kendimi.

Sayfa 1'e yapıştırdığım veriler çoklu olarak gözüküyor gördüğünüz gibi benim istemiş olduğum, verileri sayfa 1'e yapıştırdğımda çoklu olanları otomatik olarak Sayfa 2'de tek hanelere düşürsün.

Umarım anlatabilmişimdir.

 

[Murat OSMA]

Estağfurullah..

Bu kodları bir deneyiniz.

Sub ExcelTurkey()
    Dim i&, a&
    With Sayfa1
        For i = 1 To .Range("A65536").End(3).Row
            If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then
                a = a + 1
                Sayfa2.Cells(a, 1).Value = .Cells(i + 1, 1).Value
                Sayfa2.Cells(a, 2).Value = .Cells(i + 1, 3).Value & " " & .Cells(i + 1, 4).Value
            End If
        Next i
    End With
    Sayfa2.Range("$A$1:$B$10000").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    MsgBox "İşlem Tamam.", vbInformation, "Www.ExcelTurkey.Com"
End Sub

 

[adromov]

Estağfurullah..

Bu kodları bir deneyiniz.

Sub ExcelTurkey()
    Dim i&, a&
    With Sayfa1
        For i = 1 To .Range("A65536").End(3).Row
            If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then
                a = a + 1
                Sayfa2.Cells(a, 1).Value = .Cells(i + 1, 1).Value
                Sayfa2.Cells(a, 2).Value = .Cells(i + 1, 3).Value & " " & .Cells(i + 1, 4).Value
            End If
        Next i
    End With
    Sayfa2.Range("$A$1:$B$10000").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    MsgBox "İşlem Tamam.", vbInformation, "Www.ExcelTurkey.Com"
End Sub

Murat Bey kusura bakmayın tekrar rahatsız ediyorum.

Kod yapıştırma işlemini nasıl yapıyoruz alt+f11 yaptıktan sonraki adımlarda uygulamam gereken adım nedir.

 

[Murat OSMA]

Öncelikle.. mesajlarınızda bir önceki mesajı olduğu gibi alıntı yapmazsanız sevinirim. Biraz takıntılıyım o konuda. Görüntü kirliliği oluyor benim için..

• ALT + F11'e basın.
• Insert Menüsüne tıklayın.
• Module seçin.
• Kodları yapıştırın.
• F5'e basın.

 

[adromov]

@Murat OSMA Anladım murat bey,

Dediğiniz işlemleri sırasıyla yaptıktan sonra bu işlemi her yapmak istediğimde bu adımları izlemem mi gerekecek. Yoksa bununla ilgili herhangi bir buton eklenmiş olacakmı ?

 

[Murat OSMA]

Hayır.
Sayfaya gelin, Ekle menüsündeki şekillerden herhangi bir şekil seçin, butona benzer dikdörtgenlerden olabilir.
Sayfaya ekleyin, o şekil üzerinde sağ tıklayıp Makro Ata deyin, gelen pencereden prosedür adını, yani ExcelTurkey 'i seçin ve tamama basın.

Şimdi artık butona her bastığınızda kodlar çalışacaktır.

 

[adromov]

@Murat OSMA çok teşekkür ederim.

Sabrınız ve desteğiniz için

 

[Murat OSMA]

Estağfurullah.
İyi niyet karşısında, vaktim olmasa dahî her zaman sonuna kadar destek olmuşumdur.

Saygılar

 

[adromov]

@Murat OSMA Murat bey bu konuyla ilgili son bir sorabilir miyim.

Makroyu çalıştırdığımda verileri A1 değilde A2 den başlatması için vermiş olduğunuz kodda nereye değiştirmeliyim.

 

[Murat OSMA]

With Sayfa1 satırının altına bir satır ilave edin oraya da a = 1 yazın.

 

[adromov]

@Murat OSMA Murat bey makroyu kaydettikten sonra, exceli kapatıp açtığımda "makrosu çalıştırılamıyor. makro bu çalışma kitabında olmayabilir....." gibi bir hata veriyor.

nerde yanlış yapmış olabilirim

 

[Murat OSMA]

Dosyayı ekledim, denersiniz.

 

[adromov]

@Murat OSMA Çok teşekkür ederim desteğiniz için

 

[Murat OSMA]

Rica ederim, iyi günler.