k1, k2, k3, ssc_kaynak_1, ssc_kaynak_2, ssc_kaynak_3, ssc_kaynak_4, ssc_hedef_1,ssc_hedef_2
Kolonlarına sahip bir excel dosyasını
k1, k2, k3, ssc_kaynak, ssc_hedef
kolonlarına sahip hale getirmek için aşağıdaki VBA (Visual Basic Applications) Script kullanılabilir. Buradaki amaç ssc_kaynak kolonları için 4 kolonu 4 satıra, ssc_hedef kolonları için 2 kolonu 2 satıra, toplam 4+2=6 kolonu 4*2=8 satıra çevirmek.
Örneğin:
veri_k1,veri_k2, veri_k3, veri_ssc_kaynak_1, veri_ssc_kaynak_2, veri_ssc_kaynak_3, veri_ssc_kaynak_4, veri_ssc_hedef_1, veri_ssc_hedef_2
halinden aşağıdaki hale çevirmek
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_1, veri_ssc_hedef_1
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_1, veri_ssc_hedef_2
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_2, veri_ssc_hedef_1
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_2, veri_ssc_hedef_2
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_3, veri_ssc_hedef_1
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_3, veri_ssc_hedef_2
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_4, veri_ssc_hedef_1
veri_k1, veri_k2, veri_k3, veri_ssc_kaynak_4, veri_ssc_hedef_2
excel_vba_unpivot.xlsm.zip
Option Explicit
Dim sourceWorksheet As Excel.Worksheet
Dim targetWorksheet As Excel.Worksheet
Dim sourceWorksheetRowCount As Integer
Dim targetWorksheetI As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Sub Unpivot()
Set sourceWorksheet = ThisWorkbook.Worksheets("normal")
Set targetWorksheet = ThisWorkbook.Worksheets("unpivot")
targetWorksheet.Unprotect
targetWorksheet.Cells(1, 1).Value = sourceWorksheet.Cells(1, 1).Value
targetWorksheet.Cells(1, 2).Value = sourceWorksheet.Cells(1, 2).Value
targetWorksheet.Cells(1, 3).Value = sourceWorksheet.Cells(1, 3).Value
targetWorksheet.Cells(1, 4).Value = sourceWorksheet.Cells(1, 4).Value
targetWorksheet.Cells(1, 5).Value = sourceWorksheet.Cells(1, 8).Value
sourceWorksheetRowCount = sourceWorksheet.UsedRange.Rows.Count
targetWorksheetI = 2
For i = 2 To sourceWorksheetRowCount
For j = 4 To 7
For k = 8 To 9
If (IsNull(sourceWorksheet.Cells(i, j)) = False And Trim(sourceWorksheet.Cells(i, j).Value) <> "" And IsNull(sourceWorksheet.Cells(i, k)) = False And Trim(sourceWorksheet.Cells(i, k).Value) <> "") Then
targetWorksheet.Cells(targetWorksheetI, 1) = sourceWorksheet.Cells(i, 1)
targetWorksheet.Cells(targetWorksheetI, 2) = sourceWorksheet.Cells(i, 2)
targetWorksheet.Cells(targetWorksheetI, 3) = sourceWorksheet.Cells(i, 3)
targetWorksheet.Cells(targetWorksheetI, 4) = sourceWorksheet.Cells(i, j)
targetWorksheet.Cells(targetWorksheetI, 5) = sourceWorksheet.Cells(i, k)
targetWorksheetI = targetWorksheetI + 1
End If
Next k
Next j
Next i
End Sub