Excel'de Hücreyi Sütunlara Çevirip Ters Dizmek

Aşağıdaki gibi bir tablomuz var. Bir hücrede, tireler ile ayrılmış inisiyatif puanları bulunmaktadır. İstenen şu ki, "Tirelere göre rakamlar ayrılsın ve en sonda kalan rakamı, en baş sütuna getirecek şekilde, sırasal olarak dizilen yeni bir tablo oluşturulsun".

Satır ve sütunların az olması sizi yanıltmasın. Örnekte, kayıtların sadece bir kısmı mevcuttur. Gerçek tabloda, bu şekilde binlerce satır bulunmaktadır. El ile bunları, ters dizip yeni bir tablo oluşturmak pek mümkün değil. Ayrıca her satırda en son sütunda kalan, ilk sütuna gelecek şekilde, sırasal olarak yeniden dizilerek yeni bir tablo oluşturulacak.

Tabloyu inceledim. Biraz Excel yardımı ile ve biraz da VBA yardımı ile istenen tablo şekline çevirdim. Hem de bir saat gibi kısa bir zaman içinde.

Ana sütunun bir kopyasını alarak, yan sütuna yapıştırıyoruz. Kopyaladığımız sütunu seçip, Menü'de Data sekmesine tıklıyoruz. Açılan menüden Text to column tuşuna basarak, gelen formda Delimited seçeneğini seçip Next düğmesine basıyoruz.

Önce Excel'den yararlanarak, hücreleri tireye göre kolonlara çevirelim.

Sonraki sekmede tüm seçenekleri kaldırıp Other'ı seçip metin kurusuna - yazdığımız an aşağıdaki ön izlemede görüldüğü gibi, hücredeki bilgiler sütunsal hale dönüşüyor. Finish düğmesine basıp Excel'e geri dönüyoruz.

Tablomuzun yeni hali aşağıdaki şekle dönüşüyor.

Buraya kadar Excel'in standart fonksiyonları bize yardımcı oldu. Asıl işlem, sonrasında bekliyor bizi ve VBA yardımımıza yetişiyor. VBA'de kod yazmaya başlayabiliriz.

Sub TersCevir()

Dim IP1 As String
Dim IP2 As String
Dim IP3 As String
Dim IP4 As String
Dim IP5 As String
Dim IP6 As String
Dim IP7 As String
Dim Col As Integer

For i = 2 To 431

Col = 74
IP1 = CStr(ActiveSheet.Range(Chr(66) & Trim(Str(i))).Value)
IP2 = CStr(ActiveSheet.Range(Chr(67) & Trim(Str(i))).Value)
IP3 = CStr(ActiveSheet.Range(Chr(68) & Trim(Str(i))).Value)
IP4 = CStr(ActiveSheet.Range(Chr(69) & Trim(Str(i))).Value)
IP5 = CStr(ActiveSheet.Range(Chr(70) & Trim(Str(i))).Value)
IP6 = CStr(ActiveSheet.Range(Chr(71) & Trim(Str(i))).Value)
IP7 = CStr(ActiveSheet.Range(Chr(72) & Trim(Str(i))).Value)

If (Len(IP7) > 0 And Len(IP5) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP7, ",", ".")
Col = Col + 1

End If

If (Len(IP6) > 0 And Len(IP5) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP6, ",", ".")
Col = Col + 1

End If

If (Len(IP5) > 0 And Len(IP5) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP5, ",", ".")
Col = Col + 1

End If

If (Len(IP4) > 0 And Len(IP4) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP4, ",", ".")
Col = Col + 1

End If

If (Len(IP3) > 0 And Len(IP3) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP3, ",", ".")
Col = Col + 1

End If

If (Len(IP2) > 0 And Len(IP2) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP2, ",", ".")
Col = Col + 1

End If

If (Len(IP1) > 0 And Len(IP1) < 6) Then

ActiveSheet.Range(Chr(Col) & Trim(Str(i))).Value = Replace(IP1, ",", ".")
Col = Col + 1

End If

Next i

End Sub

Yukarıdaki kodumuzun hünerinden sonra tablomuzun aldığı son halin görüntüsü aşağıdaki gibidir.

Yapılması çok zor bir işlemi, VBA ile bir saat gibi kıza bir zaman diliminde gerçekleştirmiş olduk. VBA ile sizler de hünerlerinizi arttırabilirsiniz.