وَعَلَيْكُمُ لسَّلاَمُ وَرَحْمَةُ اللهِ وَبَرَكَاتُهُ
coba script berikut:
syarat:
baris data pertama berada di baris 1 kolom 1
jika data berbeda, sesuaikan rujukan pada variabel rgData dan iMod dengan
kondisi data sebenarnya
Option Explicit
Sub RowToColumn()
Dim rgData As Range, rgCell As Range
Dim iData As Integer, c As Integer, iCol As Integer
Dim r As Long, iMod As Integer
Dim myArray() As Variant
Set rgData = Range("a1").CurrentRegion
Set rgData = rgData.Resize(rgData.Rows.Count, 1)
' karena datanya per 3 baris maka dibagi 3
' kalo datanya per 16 baris maka dibagi 16
iData = rgData.Rows.Count / 3
' r adalah jumlah baris data yang akan dihasilkan dikurangi 1
' c adalah jumlah kolom data yang akan dihasilkan dikurangi 1
ReDim myArray(r = 0 To iData - 1, c = 0 To 4)
For Each rgCell In rgData
' karena jumlah data per 3 baris maka menggunakan Mod 3
' jika data per 16 baris maka diganti dengan Mod 16
iMod = rgCell.Row Mod 3
If iMod <> 0 Then
iCol = 1
myArray(r, c) = rgCell.Value
c = c + 1
Else
' karena pada setiap akhir blok data ada 3 kolom yang harus
dimasukkan nilainya
' maka nilai iCol harus sampai dengan 3
' jika pada setiap akhir blok data ada 10 kolom yang harus
dimasukkan, maka
' nilai iCol harus sampai dengan 10
For iCol = 1 To 3
myArray(r, c) = Cells(rgCell.Row, iCol).Value
c = c + 1
Next iCol
r = r + 1
c = 0
End If
Next rgCell
Cells.Clear
' jumlah baris terakhir dan kolom terakhir harus ditambah 1
' karena index Array dimulai dari nilai 0 (Nol) bukannya 1
Set rgData = Range(Cells(1, 1), Cells(r + 1, 6))
rgData = myArray
End Sub
وَسَّلاَمُ عَلَيْكُمْ وَرَحْمَةُ اللهِ وَبَرَكَاتُهُ
-Miss Jan Raisin-
- Untuk kepentingan belajar bersama, pertanyaan harap ditujukan *hanya*ke
[email protected] bukan dikirim japri ke email pribadi
member milis;
- Jika pertanyaan lama direspon, bersabarlah karena ALLAH beserta dengan
orang-orang yang sabar QS 2:153;
- Harap dipahami bersama bahwa solusi diberikan oleh Be-Exceller yang
memiliki waktu untuk on line, mengetahui solusi atas pertanyaan yang
ditanyakan, mau dan berani untuk membantu, tanpa mengharap imbalan dari
Thread Starter (TS) atau Post Starter (PS), selain itu Be-Excelller juga
memiliki kewajiban yang harus dipenuhi di dunia nyata sehingga tidak selalu
bisa on line setiap saat;
- Semoga semangat berbagi dan membantu semakin meningkat di kalangan
Be-Exceller dan menjadi amalan yang baik untuk tabungan di akhirat nanti.
اَمِين يَا رَبَّ الْعَالَمِيْن
Pada 9 Juli 2013 14.01, him mah <[email protected]> menulis:
> **
>
>
> Alhamdulillah sudah bisa, saya sedikit modifikasi VBA seperti dibawah
>
> cuma yang sedikit masalah, bagaimana caranya agar penulisannya lebih
> sederhana. kebetulan contohnya hanya cuma 3. bagaimana kalau contohnya ada
> 16 (per data) bagaimana ya. masa harus nulis satu-satu
>
>
> .Cells(iRow, 5) = arrSource(i, 3)
>
> sampai
>
> .Cells(iRow, 16) = arrSource(i, 18)
>
>
>
> Sub movetocolumns()
> Dim i As Integer, iRow As Integer
> Dim arrSource As Variant
> Dim shtAwal As Worksheet
>
> 'Set the first row
> iRow = 1
>
> Set shtAwal = Sheets("data-awal")
> With ActiveWorkbook.Worksheets("DATA-AKHIR")
>
> 'get the data into an array from the first column
> arrSource = Range(shtAwal.Cells(1, 1),
> shtAwal.Cells(shtAwal.Rows.Count, 3).End(xlUp))
>
> 'parse every value of the array and add the data to the next column
> For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
> .Cells(iRow, 1) = arrSource(i, 1)
> .Cells(iRow, 2) = arrSource(i + 1, 1)
> .Cells(iRow, 3) = arrSource(i + 2, 1)
> .Cells(iRow, 4) = arrSource(i, 2)
> .Cells(iRow, 5) = arrSource(i, 3)
>
> iRow = iRow + 1
> Next i
> 'add the remaining values
> Select Case UBound(arrSource) Mod 3
> Case 1 'one item to add
> .Cells(iRow, 1) = arrSource(i, 1)
> Case 2 'still two items to add
> .Cells(iRow, 2) = arrSource(i, 1)
> .Cells(iRow, 3) = arrSource(i + 1, 1)
> .Cells(iRow, 4) = arrSource(i, 1 + 1)
> .Cells(iRow, 5) = arrSource(i, 3)
>
> Case Else 'nothing to add
> End Select
> End With
> End Sub
>
>
>
>
> Pada 9 Juli 2013 10.46, him mah <[email protected]> menulis:
>
> terima kasih bu, sudah bisa
>>
>>
>> sebelumnya saya coba googling dan nemu ini
>>
>>
>> http://superuser.com/questions/359617/convert-one-column-into-multiple-rows
>>
>> tapi masih bingung untuk yang lebih dari satu kolom
>>
>> kalau contohnya seperti ini
>>
>> Column A
>> 1
>> 2
>> 3
>> 4
>> 5
>> 1
>> 1
>> 2
>> 3
>>
>> terus hasilnya seperti ini
>>
>> 1 2 3
>> 4 5 1
>> 1 2 3
>>
>> VBA nya seperti ini
>>
>>
>> Option Explicit
>>
>> Sub movetocolumns()
>> Dim i As Integer, iRow As Integer
>> Dim arrSource As Variant
>>
>> 'Set the first row
>> iRow = 1
>>
>> With ActiveWorkbook.Worksheets("Sheet1")
>> 'get the data into an array from the first column
>> arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
>>
>> 'parse every value of the array and add the data to the next column
>> For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
>> .Cells(iRow, 2) = arrSource(i, 1)
>> .Cells(iRow, 3) = arrSource(i + 1, 1)
>> .Cells(iRow, 4) = arrSource(i + 2, 1)
>> iRow = iRow + 1
>> Next i
>> 'add the remaining values
>> Select Case UBound(arrSource) Mod 3
>> Case 1 'one item to add
>> .Cells(iRow, 2) = arrSource(i, 1)
>> Case 2 'still two items to add
>> .Cells(iRow, 2) = arrSource(i, 1)
>> .Cells(iRow, 3) = arrSource(i + 1, 1)
>> Case Else 'nothing to add
>> End Select
>> End With
>> End Sub
>>
>>
>> kalau data saya itu seperti ini
>>
>> Column A Column B Column C 1 A 2010 2 A 2010 3 A 2010 4 B 2011 5 B
>> 2011 1 B 2011 1 C 2010 2 C 2010 3 C 2010
>> hasil yang diharapkan seperti ini
>>
>> 1 2 3 A 2010 4 5 1 B 2011 1 2 3 C 2010
>>
>>
>>
>>
>> Pada 9 Juli 2013 10.29, Jan Raisin <[email protected]> menulis:
>>
>> **
>>>
>>>
>>> وَعَلَيْكُمُ لسَّلاَمُ وَرَحْمَةُ اللهِ وَبَرَكَاتُهُ
>>>
>>> Coba bantu solusi ya.. tapi gak pakai VBA.. hanya formula biasa dengan 1
>>> kolom bantu
>>> file terlampir
>>>
>>> Jan mohon dibukakan pintu maaf atas segala salah kata selama kurang
>>> lebih 1 tahun bergabung dengan milis ini,
>>> insya ALLAH mulai besok Jan akan menjalankan shaum Ramadhan, semoga
>>> ibadah kita diterima ALLAH SWT.
>>>
>>> اَمِين يَا رَبَّ الْعَالَمِيْن
>>>
>>> وَسَّلاَمُ عَلَيْكُمْ وَرَحْمَةُ اللهِ وَبَرَكَاتُهُ
>>>
>>> -Miss Jan Raisin-
>>>
>>>
>>> - Untuk kepentingan belajar bersama, pertanyaan harap ditujukan *
>>> hanya* ke [email protected] bukan dikirim japri ke email
>>> pribadi member milis;
>>> - Jika pertanyaan lama direspon, bersabarlah karena ALLAH beserta
>>> dengan orang-orang yang sabar QS 2:153;
>>> - Harap dipahami bersama bahwa solusi diberikan oleh Be-Exceller
>>> yang memiliki waktu untuk on line, mengetahui solusi atas pertanyaan yang
>>> ditanyakan, mau dan berani untuk membantu, tanpa mengharap imbalan dari
>>> Thread Starter (TS) atau Post Starter (PS), selain itu Be-Excelller juga
>>> memiliki kewajiban yang harus dipenuhi di dunia nyata sehingga tidak
>>> selalu
>>> bisa on line setiap saat;
>>> - Semoga semangat berbagi dan membantu semakin meningkat di kalangan
>>> Be-Exceller dan menjadi amalan yang baik untuk tabungan di akhirat nanti.
>>> اَمِين يَا رَبَّ الْعَالَمِيْن
>>>
>>>
>>>
>>> Pada 8 Juli 2013 16.10, him mah <[email protected]> menulis:
>>>
>>>> **
>>>>
>>>>
>>>> Assalamu'alaikum Wr. Wb.
>>>>
>>>> Saya Punya database yang sebenarnya sudah teratur, yang terdiri dari
>>>> dua kolom misal kolom ISI dan JUDUL. tiap satu data terdiri dari 3 baris
>>>> tersusun kebawah, jadi kalau ada 3 data jumlah barisnya ada 9
>>>>
>>>> misal database awalnya seperti ini
>>>>
>>>>
>>>> ISI JUDUL 1 P-A 7317009090 P-B 04-JAN-11 P-C 1 P-A 7219130000
>>>> P-B 05-JAN-11 P-C 2 P-A 7219130000 P-B 05-JAN-11 P-C
>>>> kemudian database tersebut diubah menjadi seperti ini
>>>>
>>>> P-A P-B P-C 1 7317009090 04-JAN-11 1 7219130000 05-JAN-11 2
>>>> 7219130000 05-JAN-11
>>>> kira-kira kalau ingin hasil seperti diatas, VBA nya seperti Apa ya
>>>>
>>>> terima kasih
>>>>
>>>> _
>>>>
>>>
>>
> _
>
