Makro yazmam gerekiyor yardım alabilirmiyim..

[AzazelGTR]

........dosya no ...... .. tc .... ..... iletişim
TT 2014511308 11111111119 5303833318

TT 2014529103 11111111111 5303261332 5465108631( gibi )
TT 2014529103 11111111111 5465108631

TT 2014428375 11111111113 3722561625

TT 2014484701 11111111114 5301587486 5412937872 5078312753 3722651507 (gibi)
TT 2014484701 11111111114 5412937872
TT 2014484701 11111111114 5078312753
TT 2014484701 11111111114 3722651507

TT 2014552782 11111111112 5342047683
TT 2014552782 11111111112 5448476761
TT 2014552782 11111111112 5353293457
TT 2014552782 11111111112 3722687073

yukardaki örnekteki gibi exelde 7000 satırda bilgilerimiz mevcut, benim yapmak istediğim aynı dosya numarasındaki farklı numaraları tek satırada yan yana koymak, yani aslında bu 7000 satırda farksız olan 3000 dosyam var yardımcı olursanız sevinirim .:yardim:

 

[manyakbiri]

Makro bilgim çok az, sizin yerinizde olsam şu şekilde yapardım.

-Pivot tablo oluştururum.
-Satır kısmına ilk Dosya No'yu, onun hemen altına İletişim'i koyarım.
-Sonra karşımıza çıkan tabloda, teker teker her dosya numarasının altındaki iletişim numaralarını kopyalayıp, dosya numarasının yanına transpozesini yapıştır şeklinde yapıştırırım.

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.

Verilerin A:C sütun aralığında ve aynı TC Kimlik Numarası olanların alt alta listelenmiş olduğu varsayıldı.

C sütunundaki veriler, B sütunundaki TC Kimlik Numarası kriterine göre D sütununa birleştirilir.
İşlem öncesinde; varsa D sütunundaki verilerinizi başka bir alana alın.
.

[B]Sub BIRLESTIR()[/B]
Range("D2:D" & Cells(Rows.Count, "A").End(3).Row).ClearContents
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    adet = WorksheetFunction.CountIf([B:B], Cells(sat, "B"))
    If adet > 1 Then
        For satt = sat To sat + adet - 1
            metin = metin & " " & Cells(satt, "C")
        Next
        Cells(sat, "D") = Mid(metin, 2, Len(metin) - 1)
        sat = sat + adet - 1
    End If: metin = ""
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

 

[AzazelGTR]

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.

Verilerin A:C sütun aralığında ve aynı TC Kimlik Numarası olanların alt alta listelenmiş olduğu varsayıldı.

C sütunundaki veriler, B sütunundaki TC Kimlik Numarası kriterine göre D sütununa birleştirilir.
İşlem öncesinde; varsa D sütunundaki verilerinizi başka bir alana alın.
.

[B]Sub BIRLESTIR()[/B]
Range("D2:D" & Cells(Rows.Count, "A").End(3).Row).ClearContents
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    adet = WorksheetFunction.CountIf([B:B], Cells(sat, "B"))
    If adet > 1 Then
        For satt = sat To sat + adet - 1
            metin = metin & " " & Cells(satt, "C")
        Next
        Cells(sat, "D") = Mid(metin, 2, Len(metin) - 1)
        sat = sat + adet - 1
    End If: metin = ""
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

Merhabalar,
Öncelikle çok teşekkür ederim, makro işimi çözüyor ancak telefon numaralarının hepsini aynı hücrede topluyor. Onların ayrı satırlara yan yana olması konusunda bir çözüm var mı ?

 

[Ömer BARAN]

Aşağıdaki kod istediğiniz işlemi yapar.
D sütunundan itibaren veri tablonuzun sağındaki alanda verileriniz varsa; kodu, bu verileri başka sayfaya aldıktan sonra çalıştırın.
.

[B]Sub SUTUNLARA_YAZ()[/B]
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    adet = WorksheetFunction.CountIf([B:B], Cells(sat, "B"))
    If adet > 1 Then
        For sut = 4 To adet + 2
            Cells(sat, sut) = Cells(sat + sut - 3, "C")
        Next: sat = sat + adet - 1
    End If
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

 

[AzazelGTR]

Aşağıdaki kod istediğiniz işlemi yapar.
D sütunundan itibaren veri tablonuzun sağındaki alanda verileriniz varsa; kodu, bu verileri başka sayfaya aldıktan sonra çalıştırın.
.

[B]Sub SUTUNLARA_YAZ()[/B]
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    adet = WorksheetFunction.CountIf([B:B], Cells(sat, "B"))
    If adet > 1 Then
        For sut = 4 To adet + 2
            Cells(sat, sut) = Cells(sat + sut - 3, "C")
        Next: sat = sat + adet - 1
    End If
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

Çok teşekkürler vallahi işimi çok rahatlattın reis eyvallah

 

[Ömer BARAN]

Tekrar merhaba Sayın AzazelGTR.

Kusura sakmayın ama söylemem lazım.

Ortada HAYDUT ÇETESİ, KIZILDERİLİ KABİLESİ falan olmadığından; kullandığınız sıfatı hiç anlamlandıramadım.

Başkasını bilmem ama, bu sıfat bana malesef hiç olumlu şeyler çağrıştırmadı.
.