Merubah data horizontal menjadi vertikal

  1. 2 minggu lalu

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

    @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. minggu lalu

    Caton

    Nov 30 Terverifikasi Indonesia + 15.164 Poin

    @fredi ...

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

    Demikian.

  3. 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.164 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. Oke Mas @Caton terimakasih atas jawaban dan waktuya... semoga sehat selalu...

  6. Mas @Caton saya sudah mencoba memasukan script ini

  7. 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.164 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. Oh iya ini mas @Caton

  10. Caton

    Des 3 Terverifikasi Indonesia + 15.164 Poin
    Di sunting minggu 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. Oh iya mass... terimakasih mas@Caton

  12. 3 hari yang lalu

    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

    Des 7 Terverifikasi Indonesia + 15.164 Poin

    @fredi ...

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

    Demikian.

  14. kemarin

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

  15. Caton

    kemarin Terverifikasi Indonesia + 15.164 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.

  16. Berarti ketika saya memasukan kode A6, A9 atau bahkan A 12 fungsi ini jadi tidak berfungsi ya mas@Caton karena maksimalnya 5?

    Jadi permasalahannya seperti ini, ya semua itu bisa diatasi dengan membuat kolom mutlak( misalnya dari beberapa data.. maksimal 12 kode.. jadi saya bisa membuat datakolom pertama menjadi 36 kolom (12x3) jadi jika ada kode yang kurang 12 bisa tetampung)

    tetapi maaf mas @Caton saya ingin belajar jadi tanya terus hehehe... semoga mas @Caton berkenan...misal kita membuat jumlah kolom yang tidak mutlak (pada contoh file revisi , tidak mesti kode terakhir itu 5, bisa saja kodenya A3, A6, A7, A10, A12, Meskupin jumlah kolomnya hanya 5) kira-kira script yang perlu dirubah bagian mana ya mas@Caton

 

atau Mendaftar untuk ikut berdiskusi!