Hücreleri yan yana yazdırma

[buurakengin]

sıra_no	cins	il_kodu	fiyat
1	araba	34	16
2	araba	34	15
3	araba	33	14
4	araba	33	12
5	araba	33	13

Yukarıdaki tabloyu il koduna göre tek hale düşürüp fiyatları yan yana yazdırmak istiyorum. Çıktı olarak aşağıdaki gibi olmasını istiyorum. Çıktıyı yeni bir sayfada olmasını istiyorum herhangi bir karmaşa olmaması için.
Örnek il_kodu 34 olan iki fiyat var ve yanına iki fiyatını yazdı. 33 olanda üç fiyat var ve o üç fiyatı yanına yazdı.

il_kodu
34	16	15
33	14	12	13

Bu konuda yardımlarınızı bekliyorum, teşekkür ederim.

 

[Necdet]

Merhaba,
Verilerin Sayfa1 de olduğu varsayılmıştır. Sayfa2 ise listenin yazıldığı sayfa adı olmalı.
Referanslardan Microsoft Sicripting Runtime seçili olmalı.

Public Sub Listele()
'Referanslardan Microsoft Scripting Runtime SEÇİLİ OLMALI


Dim arr As Variant, _
    dic As New Dictionary, _
    i   As Long, _
    deg As Variant

Application.ScreenUpdating = False

arr = Sheets("Sayfa1").Range("A1").CurrentRegion

For i = LBound(arr, 1) To UBound(arr, 1)
    If Not dic.Exists(arr(i, 3)) Then
        dic.Add arr(i, 3), arr(i, 3) & ";" & arr(i, 4)
    Else
        deg = dic.Item(arr(i, 3))
        deg = deg & ";" & arr(i, 4)
        dic.Item(arr(i, 3)) = deg
    End If
Next i

Sheets("Sayfa2").Cells.ClearContents

deg = dic.Items
For i = 1 To dic.Count
    Sheets("Sayfa2").Cells(i, 1) = deg(i - 1)
Next i
    Sheets("Sayfa2").Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Application.ScreenUpdating = True

End Sub

 

[buurakengin]

Emeğinisa sağlık, çalıştı

 

[buurakengin]

Necdet Bey merhaba, bu koda ilave olarak üç değişken kolonu daha eklemek istiyorum. Kodda nasıl bir değişiklik gerekiyor bunun için?

Örnek olarak sadece il kodunu değil bunun yanında şube kodu, vergi kodu ve ilçe kodunuda eklemek istiyorum

Şube kodunu 1, vergi kodunu2, ilçe kodunu 5 kolon numaraları ile alabiliriz.

Yardımcı olabilir misiniz? Teşekkür ederim

 

[Necdet]

Merhaba,
Örnek dosyanızı paylaşım sitelerinden birine yüklerseniz çözüme daha hızlı ulaşırsınız.
buradan anlatması zor.

    If Not dic.Exists(arr(i, 3)) Then
        dic.Add arr(i, 3), arr(i, 3) & ";" & arr(i, 4)
    Else
        deg = dic.Item(arr(i, 3))
        deg = deg & ";" & arr(i, 4)
        dic.Item(arr(i, 3)) = deg
    End If

Yapabilirseniz değiştirilecek satırlar yukarıda belirttiğim satırlar.
dic.Add ile arr(i,3) anahtar sözcük İl eklenmiş oluyor, siz bu il ile birlikte sözünü ettiğiniz ilçe, şube vs yi de birleştirerek yazmanız gerekir.

Virgülden sonrakilerinde de sonradan fazla işlem yapmadan yine il ile birlikte fiyatı da Item olarak yazdırıyorum.
Siz buna da yine key ile belirtilen değerlerle birlikte fiyatı da eklemeniz gerekecek.

Kodların aşağısında ise değişiklik yapmanıza gerek kalmayacaktır.
Deneyin isterim.