Komentari
116 Kali Dilihat

Merubah data horizontal menjadi vertikal

  1. minggu lalu

    fredi

    Nov 29 + 527 Poin

    Assalamu'alaikum...
    mohon bantuannya..saya ingin merubah data dalam bentuk horizontal menjadi vertikal dalam satu kolom dengan kode tertentu

    Terjawab oleh Caton

    Lihat Jawaban terkait

    @fredi ...

    Pertama, pada contoh script yang saya berikan, temukan baris script berikut :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
    Sheet3.Cells(lRow, "B").Value2 = lRow - 4
    Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
    Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
    Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
    lRow = lRow + 1
Next
...

    [1]. Kemudian, jika yang mas maksud adalah jika ada baris kosong pada kolom B (range B8:B17) seperti gambar berikut,

    [attachment:5de48589e4b55]

    maka ubah baris script di atas dengan menambahkan blok IF seperti berikut ini :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    '+-- Tambahkan kondisional ini.
    If Len(xDataRow(lZ, 1)) Then
        lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
        Sheet3.Cells(lRow, "B").Value2 = lRow - 4
        Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
        Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
        Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
        lRow = lRow + 1
    End If
Next
...

    [2]. Atau, kalau yang dimaksud adalah ada baris data (nilai) yang kosong pada range C8:Q17 seperti gambar berikut,

    [attachment:5de4875f5bfcd]

    maka ubah baris script di atas dengan menambahkan blok IF menjadi seperti berikut ini :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    '+-- Tambahkan kondisional ini.
    If Len(xDataVal(lZ, lCol)) Then
        lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
        Sheet3.Cells(lRow, "B").Value2 = lRow - 4
        Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
        Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
        Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
        lRow = lRow + 1
    End If
Next
...

    [3]. Atau, jika kondisi yang akan dihindari adalah seperti poin 1 dan poin 2 di atas, maka tambahkan saja bolk IF seperti berikut ini :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    '+-- Tambahkan kondisional ini.
    If Len(xDataRow(lZ, 1)) Then
        If Len(xDataVal(lZ, lCol)) Then
            lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
            Sheet3.Cells(lRow, "B").Value2 = lRow - 4
            Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
            Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
            Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
            lRow = lRow + 1
        End If
    End If
Next
...

    Demikian.

  2. Caton

    Nov 30 Terverifikasi Indonesia + 15.163 Poin

    @fredi ...

    Klo pake formula, ribet... :) Saya ganti pake macro VBA saja ya. Filenya terlampir. Semoga sesuai...

    Demikian.

  3. fredi

    Des 2 + 527 Poin

    Terimakasih mas @Caton atas jawabannya, namun bolehkan saya bertanya lagi ....? saat saya merubah data baris, pada baris yang kosong ikut dalam data hasil... adakah cara agar data yang nantinya diinputkan dalam sheet hasil hanya data yang isi saja... masalahnya nantinya datanya berubah-ubah...

  4. Caton

    Des 2 Terverifikasi Jawaban Terpilih Indonesia + 15.163 Poin

    @fredi ...

    Pertama, pada contoh script yang saya berikan, temukan baris script berikut :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
    Sheet3.Cells(lRow, "B").Value2 = lRow - 4
    Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
    Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
    Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
    lRow = lRow + 1
Next
...

    [1]. Kemudian, jika yang mas maksud adalah jika ada baris kosong pada kolom B (range B8:B17) seperti gambar berikut,

    baris-kosong.png

    maka ubah baris script di atas dengan menambahkan blok IF seperti berikut ini :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    '+-- Tambahkan kondisional ini.
    If Len(xDataRow(lZ, 1)) Then
        lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
        Sheet3.Cells(lRow, "B").Value2 = lRow - 4
        Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
        Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
        Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
        lRow = lRow + 1
    End If
Next
...

    [2]. Atau, kalau yang dimaksud adalah ada baris data (nilai) yang kosong pada range C8:Q17 seperti gambar berikut,

    baris-kosong2.png

    maka ubah baris script di atas dengan menambahkan blok IF menjadi seperti berikut ini :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    '+-- Tambahkan kondisional ini.
    If Len(xDataVal(lZ, lCol)) Then
        lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
        Sheet3.Cells(lRow, "B").Value2 = lRow - 4
        Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
        Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
        Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
        lRow = lRow + 1
    End If
Next
...

    [3]. Atau, jika kondisi yang akan dihindari adalah seperti poin 1 dan poin 2 di atas, maka tambahkan saja bolk IF seperti berikut ini :

    ...
For lZ = 1 To UBound(xDataRow, 1)
    '+-- Tambahkan kondisional ini.
    If Len(xDataRow(lZ, 1)) Then
        If Len(xDataVal(lZ, lCol)) Then
            lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
            Sheet3.Cells(lRow, "B").Value2 = lRow - 4
            Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
            Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
            Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
            lRow = lRow + 1
        End If
    End If
Next
...

    Demikian.

  5. fredi

    Des 2 + 527 Poin

    Oke Mas @Caton terimakasih atas jawaban dan waktuya... semoga sehat selalu...

  6. 6 hari yang lalu

    fredi

    Des 3 + 527 Poin

    Mas @Caton saya sudah mencoba memasukan script ini

  7. fredi

    Des 3 + 527 Poin

    pada sheet hasil muncul eror, yaitu ada 2 kode yang salah (apakah efek dari kode jeruk yang belum terisi?)
    sedangkan data yang dimaksud kosong adalah sebagai berikut.. mohon bantuannya

  8. Caton

    Des 3 Terverifikasi Indonesia + 15.163 Poin

    @fredi ...

    Untuk nama range dbData.Baris dan dbData.Nilai, rujukannya sudah benar belum mas? Saya coba (setelah rujukan nama range yang digunakan saya atur ulang), hasilnya sesuai... Coba periksa dahulu rujukan nama rangenya, atau lampirkan saja filenya.

    Demikian.

  9. fredi

    Des 3 + 527 Poin

    Oh iya ini mas @Caton

  10. Caton

    Des 3 Terverifikasi Indonesia + 15.163 Poin
    Di sunting 6 hari yang lalu oleh Caton

    @fredi ...

    Script hasil modifikasi yang mas buat seperti berikut :

    ...
lRow = 5
Sheet3.Range("B5:E204").ClearContents
For lX = 1 To lMaxC
    sPrefix = vbNullString
    sSuffix = vbNullString
    For lY = 1 To lMaxB
        lCol = lMaxC * (lY - 1) + 1
        If xDataCol(1, lCol) <> vbNullString Then
            sPrefix = UCase$(Left$(xDataCol(1, lCol), 1))
        End If
        If xDataCol(3, lCol + lX - 1) <> vbNullString Then
            sSuffix = Trim$(xDataCol(3, lCol + lX - 1))
            sCode = sPrefix & sSuffix
        End If
        For lZ = 1 To UBound(xDataRow, 1)
            If Len(xDataVal(lZ, lCol)) Then
                lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
                Sheet3.Cells(lRow, "B").Value2 = lRow - 4
                Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
                Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
                Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
                lRow = lRow + 1
            End If
        Next
    Next
Next
...

    Masalahnya, pada script modifikasi yang mas buat, mas menempatkan blok IF berikut :

    ...
If xDataCol(3, lCol + lX - 1) <> vbNullString Then
    sSuffix = Trim$(xDataCol(3, lCol + lX - 1))
    sCode = sPrefix & sSuffix
End If
...

    sebagai blok IF sendiri. Padahal, script yang saya susun pada lampiran file saya di atas blok IF tersebut merupakan induk untuk blok FOR ... NEXT berikutnya :

    ...
If xDataCol(3, lCol + lX - 1) <> vbNullString Then
    sSuffix = Trim$(xDataCol(3, lCol + lX - 1))
    sCode = sPrefix & sSuffix
    For lZ = 1 To UBound(xDataRow, 1)
        lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
        Sheet3.Cells(lRow, "B").Value2 = lRow - 4
        Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
        Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
        Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
        lRow = lRow + 1
    Next
End If
...

    Jadi, seharusnya modifikasi scriptnya tersusun seperti berikut ini :

    ...
If xDataCol(3, lCol + lX - 1) <> vbNullString Then
    sSuffix = Trim$(xDataCol(3, lCol + lX - 1))
    sCode = sPrefix & sSuffix
    '+-- Masukkan blok FOR ini di dalam blok IF di atas.
    For lZ = 1 To UBound(xDataRow, 1)
        If Len(xDataVal(lZ, lCol)) Then
            lCol = (lMaxC * (lY - 1) + 1) + (lX - 1)
            Sheet3.Cells(lRow, "B").Value2 = lRow - 4
            Sheet3.Cells(lRow, "C").Value2 = UCase$(xDataRow(lZ, 1))
            Sheet3.Cells(lRow, "D").Value2 = UCase$(sCode)
            Sheet3.Cells(lRow, "E").Value2 = xDataVal(lZ, lCol)
            lRow = lRow + 1
        End If
    Next
End If
...

    Saat ini, itu masalah yang saya temukan. Terlampir revisinya.

    Demikian.

  11. fredi

    Des 3 + 527 Poin

    Oh iya mass... terimakasih mas@Caton

  12. 2 hari yang lalu

    fredi

    Des 7 + 527 Poin

    Mas @Caton bolehkah saya tanya lagi, setelah saya mengacak kode pada data kolom ... pada shet hasil vba tidak urut.... padahal yang saya harapkan data kolom itu A1,A2, dst menjadi kode urut setalah kode Nama Buah...

  13. Caton

    2 hari yang lalu Terverifikasi Indonesia + 15.163 Poin

    @fredi ...

    Contoh terlampir (periksa prosedur Sub FillDataTable). Semoga sesuai...

    Demikian.

  14. 3 jam yang lalu

    fredi

    3 jam yang lalu + 527 Poin

    Wow terimakasih mas@Caton tapi apakah saya boleh bertanya maksud dari script 1X,1Y, 1Z, MAK A, MAX B, MAX C

  15. Sekarang

    Caton

    36 menit yang lalu Terverifikasi Indonesia + 15.163 Poin

    @fredi ...

    Tujuan dari masing-masing variabel adalah :

    lMaxA = Jumlah kolom data ( kolom C s.d. kolom Q ) = 15
lMaxB = Jumlah variabel pada nama range C5:Q5 ( Mangga, Jeruk, Semangka ) = 3
lMaxC = Jumlah maksimum data per kelompok data ( lMaxA / lMaxB ) = 5

lX = Variabel iterasi per kelompok data ( 1 s.d. lMaxC )
lY = Variabel iterasi sebanyak jumlah kolom data ( 1 s.d. lMaxA )
lZ = Variabel iterasi sebanyak jumlah baris data ( 1 s.d. UBound(xDataRow, 1) )

    Variabel lX akan menghasilkan nilai 1 s.d. 5 ( 5 merupakan nilai pada variabel lMaxC ) yang digunakan untuk membentuk sufiks dari data yang akan diperiksa :

    A1, A2, A3 ... A5

    Setiap sufiks yang dihasilkan oleh iterasi tersebut, kemudian diperiksa apakah ada pada kolom data range C7:Q7. Iterasi dilakukan sebanyak jumlah kolom yakni dari 1.s.d. 15 ( 15 merupakan nilai pada variabel lMaxA ). Oleh karena nama kelompok data hanya ada pada sel pertama dari setiap kelompok ( Mangga = C5, Jeruk = H5, Semangka = M5), maka pada saat iterasi kedua ( yakni iterasi pada variabel lY ) ini, apabila ada nama kelompok data, dibuat menjadi prefiks.

    Pada iterasi kedua ini, setiap sel data pada range C7:Q7 akan dibandingkan dengan sufiks yang sudah dibuat. Apabila nilai di setiap sel tersebut sama dengan sufiks, maka buat kodenya :

    sCode = sPrefix & sSuffix

    Misalkan, nama kelompok MANGGA dan sufiksnya A1, maka kodenya menjadi MA1. Kemudian lakukan iterasi sebanyak baris data untuk setiap kode tersebut ( yakni iterasi pada variabel lZ ). Pada iterasi ketiga ini, nilai yang akan dituliskan ke tabel akhir hanyalah jika sel pada baris dan kolom terkait ada nilainya saja.

    Selanjutnya, iterasi akan kembali ke iterasi kedua yang akan mencari apakah ada lagi data pada range C7:Q7 yang sama dengan sufiks yang dicari. Jika tidak ada, maka proses akan kembali ke iterasi pertama untuk membuat sufiks selanjutnya dan seterusnya...

    Demikian.

 

atau Mendaftar untuk ikut berdiskusi!