Sütun Sıralamasını değiştirmek

[ccuneyt13]

Herkese Merhaba;

Yaklaşık 200 başlık olan bir excel raporu var. Bu rapor farklı bir sistemden alınıyor. Bu nedenle içerdiği başlıklarının sıralaması her seferinde farklı gelebiliyor, yada yeni eklenen bazı kolonlar olabiliyor.

Birkaç başlık mesela

A sütunu: İsim

B sütunu: Adres

C sütünü: Telefon

D sütunu: Mail

Vs. devam ediyor.



Bu başlık sıralamasına göre kullanmış olduğum makro vs formüller var, buraya kadar sorun yok.

Ancak bu farklı yerden alınan raporun yeni alındığında başlık sıraları farklı gelebiliyor, yada bir önceki raporda olmayan yeni başlıklar olabiliyor.

Dolayısıyla yukarıdaki sıralama şöyle olabiliyor;

A sütunu: Adres

B sütunu: TCKN (daha önce olmayan bir kolon)

C sütünü: İsim

D sütunu: Telefon

Yapmak istediğim şu; 1 satırda yer alan başlık isimlerine göre sütunları kes yapıştır yaparak istediğim gibi sıralamak istiyorum.

Gelen raporda 1. satırdaki başlık isimlerinden A sütunun da olmasını istediğim “Telefon” kolonu diyelim Z1 Hücresinde. Başlık satırında “Telefon” başlığını bulup o başlığa ait sütunu aşağıdaki gibi bir kodla Z kolonundan A ya taşımak istiyorum.

Columns("Z:Z").Select

Selection.Cut

Columns("A:A").Select

Selection.Insert Shift:=xlToRight

Daha sonra diyelim ki “Adres” gelecek. “Adres” başlık ismini arayıp misal BA kolundan B ye, “Mail” kolonunu AF kolundan C ye gibi devam edecek.

200 başlığın hangisinin kaçıncı başlık olduğunu kodun başında tanımladıktan sonra her sütun için tek tek kod yazmadan bu tanımlanan başlıkların sıralamasına göre kes yapıştır yaptırabilir miyiz.

Ayrıca 200 başlık dışında tanımlama yapılmayan yeni bir başlık varsa o başlığa ait kolon veya kolonlarda en son da olacak.

Örnek tanımlama:

İsim = 1

Adres = 2

Telefon = 3

Mail = 4

Çok teşekkür ederim

 

[YUSUF44]

Aşağıdaki gibi bir makro kullanabilirsiniz. Array içinde başlıklarınızın sırasını istediğiniz gibi ayarlayabilirsiniz:

Sub baslik_tasi()
Dim baslik As Variant
baslik = Array("İsim", "Adres", "Telefon", "Mail")

For i = 0 To UBound(baslik)
    sut = WorksheetFunction.Match(baslik(i), [1:1], 0)
    Columns(sut).Cut
    Columns(i + 1).Insert Shift:=xlToRight
Next
End Sub

 

[ccuneyt13]

Aşağıdaki gibi bir makro kullanabilirsiniz. Array içinde başlıklarınızın sırasını istediğiniz gibi ayarlayabilirsiniz:

Sub baslik_tasi()
Dim baslik As Variant
baslik = Array("İsim", "Adres", "Telefon", "Mail")

For i = 0 To UBound(baslik)
    sut = WorksheetFunction.Match(baslik(i), [1:1], 0)
    Columns(sut).Cut
    Columns(i + 1).Insert Shift:=xlToRight
Next
End Sub

Yusuf Bey, öncelikle teşekkür ederim,
Deneme için gerçek başlık isimlerini array kısmına tanımlarken aşağıdaki hatayı aldım. Çok uzun bir kod satırı oldu "_" alt tire ile alt satırlara geçtim ama bir noktada hatayı gideremedim. Tavsiyenize ihtiyacım var bu noktada .

 

[Haluk]

Çok fazla "_" kullanmışınız..... verdiği hata mesajı bu.

.

 

[YUSUF44]

Diziler konusunda çok bilgili değilim. Belki dosyada bir sütuna başlıkları yazıp ordan almasını sağlayabilirsiniz.

 

[Korhan Ayhan]

Ekteki dosyayı deneyiniz.

 

[ccuneyt13]

Ekteki dosyayı deneyiniz.

Korhan Bey, teşekkür ederim biraz sonra deneyeceğim. Sonuç hakkında dönüş yaparım.
Saygılar.

 

[ccuneyt13]

Aşağıdaki gibi bir makro kullanabilirsiniz. Array içinde başlıklarınızın sırasını istediğiniz gibi ayarlayabilirsiniz:

Sub baslik_tasi()
Dim baslik As Variant
baslik = Array("İsim", "Adres", "Telefon", "Mail")

For i = 0 To UBound(baslik)
    sut = WorksheetFunction.Match(baslik(i), [1:1], 0)
    Columns(sut).Cut
    Columns(i + 1).Insert Shift:=xlToRight
Next
End Sub

Yusuf Bey,
Tanımlama sorununu aştım, bir kaç "" işareti eksikmiş.
Şuan sorunum şu, = Array("İsim", "Adres", "Telefon", "Mail") olarak kodu yazdım çalıştıracağım zaman ilk sütun da zaten İsim başlığı var ise aşağıdaki hatayı aldım,


ilk başlık ile Array ilk tanımdaki aynı ise yapma gibi bir ilave yapmak mümkün mü acaba ?
Teşekkür ederim
Saygılar.

 

[YUSUF44]

Aşağıdaki gibi olabilir:

Sub baslik_tasi()
Dim baslik As Variant
baslik = Array("İsim", "Adres", "Telefon", "Mail")

For i = 0 To UBound(baslik)
    If Cells(1, i + 1) = baslik(i) Then GoTo 10
    sut = WorksheetFunction.Match(baslik(i), [1:1], 0)
    Columns(sut).Cut
    Columns(i + 1).Insert Shift:=xlToRight
10:
Next
End Sub

 

[ccuneyt13]

Ekteki dosyayı deneyiniz.

Korhan Bey,
Çok teşekkür ederim İstediğimi yapabildim, Teşekkürler, Saygılar.

 

[ccuneyt13]

Aşağıdaki gibi olabilir:

Sub baslik_tasi()
Dim baslik As Variant
baslik = Array("İsim", "Adres", "Telefon", "Mail")

For i = 0 To UBound(baslik)
    If Cells(1, i + 1) = baslik(i) Then GoTo 10
    sut = WorksheetFunction.Match(baslik(i), [1:1], 0)
    Columns(sut).Cut
    Columns(i + 1).Insert Shift:=xlToRight
10:
Next
End Sub

Yusuf Bey Merhaba,
Bu ilk başlık için sorun kalmadı, ancak son başlıkta aynı hatayı verdi.
Hata verse de son başlık için tanımlama zaten sonda kaldığı için aslında başarılı olarak yaptı ama sonda hata vermiş oldu.

 

[YUSUF44]

Benim denemelerimde başta ya da sonda olması sıkıntı çıkarmadı. O nedenle yorum yapamayacağım. İsterseniz dosyanızı o haliyle yani hata verecek haliyle paylaşın inceleyelim.