Aynı isimde olan ama farklı seri numaralara sahip bir ürünü Excel'de yan yana getirmek

Aynı isimde olan ama farklı seri numaralara sahip bir ürünü Excel'de yan yana getirmek isteyenler için.

isim seri no
x 10000
x 10001
x 10002


şeklindeki veriyi

isim seri no
x 10000 10001 10002

şekline çevirmektedir. (isim A sütununda olmalı)

yani buşekilde olan veri;

bu şekilde olmasını istiyoruz.

bunun için ise Excelde makro kod yazmamız gerekiyor. Excelde Alt+F11 den sonra gelen ekrana şu kodları yazıp üst taraftan çalıştır dediğimizde istediğimiz şekle girmiş olacaktır.

Kodlar şu şekilde;

Option Explicit

Sub Consolidate()

'Columnar data is Sorted/Matched by column A values, merge all other cells into row format
Dim LastRow As Long, NextCol As Long
Dim LastCol As Long, Rw As Long, Cnt As Long
Dim delRNG As Range
Application.ScreenUpdating = False

'Sort data
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    
'Seed the delete range
    Set delRNG = Range("A" & LastRow + 10)
    
'Group matching names
    For Rw = LastRow To 2 Step -1
        If Cells(Rw, "A").Value = Cells(Rw - 1, "A").Value Then
            Range(Cells(Rw, "B"), Cells(Rw, Columns.Count).End(xlToLeft)).Copy _
                Cells(Rw - 1, Columns.Count).End(xlToLeft).Offset(0, 1)
            Set delRNG = Union(delRNG, Range("A" & Rw))
        End If
    Next Rw

'Delete unneeded rows all at once
    delRNG.EntireRow.Delete (xlShiftUp)
    Set delRNG = Nothing

'Add titles
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    LastCol = Cells(1, 1).CurrentRegion.Columns.Count
    Range("B1", Cells(1, NextCol - 1)).Copy Range(Cells(1, NextCol), Cells(1, LastCol))

Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Bir sonraki derste görüşmek üzere...

 

Yusuf Ziya Sosan
2009'dan bu yana C# ile ilgileniyor, kodlama ve yazılım çalışmaları yapıyor.
Yorum Yaz

Yorum yazabilmek için üye girişi yapmanız gerekiyor!

Yukarı Git