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
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