tampaknya mas Nang Agus kelupaan satu kondisi.

Sub kopi()
Dim baris As Long, tinggi As Integer, x As Integer
Dim wadah As String
tinggi = Range("c1000000").End(xlUp).Row
For x = tinggi To 7 Step -1
If Cells(x, 1).Value = 0 Then
wadah = Cells(x, 3).Value & wadah
Cells(x, 3).Value = ""
If Cells(x, 5).Value <> 0 Then
baris = Cells(x, 5).Value
Cells(x, 5).Value = ""
End If
Else
wadah = Cells(x, 3).Value & wadah
Cells(x, 3).Value = wadah
wadah = ""
   if Cells(x, 5).Value<>0 then
Cells(x, 5).Value = baris
   endif
End If

Next x
End Sub

Script diatas sekaligus menyusun sebuah data teks (lihat variabel bernama
wadah) dari beberapa baris data. Tampaknya ini dimaksudkan untuk menyusun
record data yang baik, sehingga tabel hasil bisa mengikuti kaidah tabel
database yang baik pula.

Catatan :
1. variabel baris tampaknya untuk menyimpan suatu nilai numerik. Pada
script di atas, tipe data di set menampung bilangan bulat saja dengan
maksimum sekitar 2 x 10^10 lebih dikit.
> andai data yang disimpan memiliki kemungkinan berjumlah digit lebih dari
9, sebaiknya tipe data variabel baris diubah menjadi double

2. variabel tinggi untuk menyimpan nomor baris Excel terakhir yang akan
diproses. Tipe data yang digunakan adalah integer yang dibatasi sampai
32000 sekiun.
> Andai kemungkinannya baris Excel yang digunakan oleh data mencapai lebih
dari 32000 sekiun, maka sebaiknya tipe datanya diubah menjadi Long

3. variabel x yang digunakan dalam loop dengan for next juga seperti
variabel tinggi.

4. untuk mendapatkan baris excel terakhir data bisa juga dengan bunyi kode
berikut : (lihat baris kode set nilai tinggi)
      tinggi =  cells(rows.count,3).end(xlup).row      '3 adalah kolom c
         'Range("c1000000").End(xlUp).Row

5. berhubung loop dengan for next, maka baris berbunyi for blabla akan
dieksekusi 1 kali saja.
> berarti, baris :
           For x =* tinggi *To 7 Step -1
bisa diganti dengan :
           For x =  *cells(rows.count,3).end(xlup).row* To 7 Step -1
dan menjadi hemat proses eksekusi karena baris 'tinggi=blabla' bisa
dihapus, dan bagian deklarasi 'tinggi as blabla' juga bisa dihapus

6. penggabungan data bertipe teks (string) yang ada dalam script di atas
tidak menyertakan delimiter antar teks yang digabung
> contoh baris :
       wadah = *Cells(x, 3).Value* & *wadah*
andai *Cells(x, 3).Value*  bernilai '*Kid*'  dan *wadah*  bernilai '*juga*'
hasilnya akan menjadi '*Kidjuga*'
> bisa jadi akan tampak lebih baik bila diberi delimiter. Misalnya
delimiter-nya berupa sebuah karakter spasi. Maka barisnya menjadi :
       wadah = *Cells(x, 3).Value* & " " & *wadah*
yang bisa menghasilkan teks hasil penggabungan berbunyi '*Kid* *juga*'

7. nomor 6 juga berlaku untuk baris kode berbunyi :
           wadah = Cells(x, 3).Value & wadah

8. variabel bernama wadah dan rujukan ke kolom C dengan Cells(x, 3)
bertugas untuk menyusun sebuah teks dari beberapa baris teks

9. katanya, set string kosong akan lebih cepat diproses dan mudah tampak
dalam editing script jika menghindari penggunaan "" dan lebih memilih
menggunakan vbnullstring
> contoh :
         Cells(x, 3).Value = ""
katanya bisa lebih cepat diproses dan mudah tampak saat editing ketika
menggunakan vbnullstring :
         Cells(x, 3).Value = vbnullstring
> hal ini berlaku untuk beberapa baris yang lain, termasuk set nilai string
kosong pada variabel bernama wadah

10. cells yang diset nilai dengan "" atau vbnullstring akan menjadi blank
cells. jadi proses ini setara dengan penggunaan methods clearcontents milik
si cells atau range

11. penghematan jumlah proses bisa dilakukan dengan meringkaskan si proses
itu sendiri
> contoh pada beberapa baris berikut : (dengan proses penggabungan teks
yang sudah diperbaiki mengikuti nomor 7
         wadah = *Cells(x, 3).Value & " " & wadah*
         Cells(x, 3).Value = wadah
         wadah = ""
"wadah (yang baru) diisi dengan nilai dari Cells(x, 3).Value yang digabung
dengan spasi dan isi wadah (yang lama)
lalu Cells(x, 3) diubah isinya dengan nilai yang disimpan dalam wadah (yang
sudah baru)
kemudian isi wadah (yang sudah baru tersebut) dibuang isinya."

> proses seperti di atas bisa diringkas dengan :
         Cells(x, 3).Value = *Cells(x, 3).Value & " " & wadah*
         wadah=vbnullstring
" Cells(x, 3) [yang baru] diisi dengan Cells(x, 3) [yang lama] digabung
dengan spasi dan isi wadah
lalu isi wadah dibuang."

> setidaknya hemat 1 proses

12. prosedur di atas menggunakan rujukan ke object yang ada di sheet aktif
(pasti di workbook yang sedang aktif)


Kalau dikumpulkan semuanya, kira-kira prosedurnya menjadi :
Sub kopi()
    Dim baris As *double*, x As *long*
    Dim wadah As String
    For x = *cells(rows.count,3).end(xlup).row* To 7 Step -1
        If Cells(x, 1).Value = 0 Then
            wadah = *Cells(x, 3).Value* & " " & *wadah*
            Cells(x, 3).Value = *vbnullstring*
            If Cells(x, 5).Value <> 0 Then
                  baris = Cells(x, 5).Value
                  Cells(x, 5).Value = *vbnullstring*
            End If
        Else
           Cells(x, 3).Value = *Cells(x, 3).Value* & " " & *wadah*
           wadah = *vbnullstring*
           if Cells(x, 5).Value<>0 then
                Cells(x, 5).Value = baris
          endif
       End If
   Next x
End Sub


Sampai disini, kalau dilihat-lihat berulang-ulang mengikuti si proses loop,
kondisi proses yang akan dicapai kira-kira bunyinya :
> mengikuti script di atas :
   a. kalau isi kolom A = 0, dilakukan :
            susun teks gabungan dan simpan di sebuah variabel
            pembersihan teks dari cell di kolom C
            a.1. kalau kolom E tidak 0, dilakukan :
                        penyimpanan nilai kolom E ke suatu variabel
                        pembersihan nilai dari cell di kolom E
   b. kalau isi kolom A <> 0   (bagian Else), dilakukan :
            tulis ke cell di kolom C gabungan nilai yang ada di kolom C
dengan teks hasil gabungan yang disimpan dalam variabel
            buang gabungan teks dari variabel
            b.1. kalau kolom E bukan 0 alias ada isinya, dilakukan :
                         tulis ke cell di kolom E suatu nilai yang disimpan
dalam variabel nilai

> jadi berdasar jabaran tentang kondisi dalam script tersebut di atas,
sebenarnya ada kondisi pokok sebagai berikut :
    1. ketika kolom E bukan 0 alias ada isinya (lihat b.1.) diperlukan
memeriksa kolom A (lihat poin a dan b)
          > pada kolom E bukan 0 ini, proses dilakukan pada saat kolom A =
0, yaitu melakukan :
                 - penggabungan teks kolom C dan menyimpannya ke suatu
variabel
                 - menyimpan nilai kolom E ke suatu variabel nilai
                 - membuang isi kolom C dan kolom E
         * kalau kolom A tidak 0, tidak diperlukan proses apapun karena
memang sudah demikian adanya
    2. ketika kolom E = 0 dan kolom A <> 0
         > pada kondisi ini, dilakukan proses :
              - menulis ke kolom C, yaitu suatu nilai hasil penggabungan
isi kolom C dengan isi variabel gabungan teks yang ada
              - membuang isi variabel gabungan teks
              - menulis ke kolom E, yaitu suatu nilai yang disimpan oleh
suatu variabel nilai
    3. ketika kolom E = 0 dan kolom A = 0
         > pada kondisi ini, dilakukan proses :
              - menggabungkan teks nilai kolom C dengan hasil penggabungan
yang ada ke suatu variabel gabungan teks
              - membuang isi kolom C

> sepertinya susunan kondisinya bisa berbentuk :
      if Cells(x, 5).Value<>0 then                                  'poin 1
             if Cells(x, 1).Value = 0
Then                                     'kondisi dalam poin 1 alias poin
1.>.
                    wadah = *Cells(x, 3).Value* & " " & *wadah*
                    baris = Cells(x, 5).Value
                    Cells(x, 3).Value = *vbnullstring*
                    Cells(x, 5).Value =
*vbnullstring*             endif
     elseif Cells(x, 1).Value <> 0 then                          'poin 2
                  Cells(x, 3).Value = *Cells(x, 3).Value* & " " & *wadah*
                  wadah = *vbnullstring*
                  Cells(x, 5).Value = baris
     else
'poin 3
              wadah = *Cells(x, 3).Value* & " " & *wadah*
              Cells(x, 3).Value = *vbnullstring*
     endif

Jadi, susunan prosedurnya akan menjadi :
*public *Sub kopi()       'tambahin explicit nya scope ah supaya mudah
membacanya
    Dim baris As *double*, x As *long*
    Dim wadah As String
    For x = *cells(rows.count,3).end(xlup).row* To 7 Step -1

        if Cells(x, 5).Value<>0 then                                  'poin
1
             if Cells(x, 1).Value = 0
Then                                     'kondisi dalam poin 1 alias poin
1.>.
                    wadah = *Cells(x, 3).Value* & " " & *wadah*
                    baris = Cells(x, 5).Value
                    Cells(x, 3).Value = *vbnullstring*
                    Cells(x, 5).Value =
*vbnullstring*             endif
        elseif Cells(x, 1).Value <> 0 then                          'poin 2
                  Cells(x, 3).Value = *Cells(x, 3).Value* & " " & *wadah*
                  wadah = *vbnullstring*
                  Cells(x, 5).Value = baris

else
'poin 3
              wadah = *Cells(x, 3).Value* & " " & *wadah*
              Cells(x, 3).Value = *vbnullstring*
        endif
   Next x
End Sub


Tentang :

> gimana kalau macronya berjalan untuk semua sheet yang ada

> merujuk ke nomor 12 di atas sana, berarti dibutuhkan prosedur lainnya
yang bertugas melakukan loop ke setiap sheet lalu mengaktifkan sheet
tersebut. Kalau sheetnya sudah aktif, panggil prosedur di atas.
dim sht as worksheet
for each sht in thisworkbook.worksheets
    sht.activate
    kopi
next sht

Biasanya kalau sudah begini, akan ada pertanyaan : bagaimana kalau ada
banyak workbook...
> rasanya sudah pada bisa.
> buat prosedur lainnya yang bertugas buka workbook (kalau belum dibuka)
loop di setiap workbook, lalu panggil prosedur yang loop setiap sheet tadi
dan ditutup dengan save workbook yang di loop dan tutup workbook yang di
loop
> sebaiknya cari-carilah di postingan lawas tentang membuka workbook lain,
tentang loop setiap workbook, dan sebagainya.

Wassalam,
Kid



2015-05-25 18:42 GMT+10:00 Ahmad Syaifullah Lubis [email protected]
[belajar-excel] <[email protected]>:

>
>
> Dear Mr Nang Agus,
> ternyata data kolom E nya menjadi salah, tidak sinkron dengan aslinya.
> terima kasih,
> ASL
>
> ------------------------------
> To: [email protected]
> From: [email protected]
> Date: Mon, 25 May 2015 13:07:02 +0700
> Subject: Re: [belajar-excel] Menyatukan 2 atau 3 baris menjadi 1 baris data
>
>
>
> Mohon maaf ada yang ketinggalan untuk kolom E, mungkin cekripnya begini:
>
> Option Explicit
> Sub kopi()
> Dim baris As Long, tinggi As Integer, x As Integer
> Dim wadah As String
> tinggi = Range("c1000000").End(xlUp).Row
> For x = tinggi To 7 Step -1
> If Cells(x, 1).Value = 0 Then
> wadah = Cells(x, 3).Value & wadah
> Cells(x, 3).Value = ""
> If Cells(x, 5).Value <> 0 Then
> baris = Cells(x, 5).Value
> Cells(x, 5).Value = ""
> End If
> Else
> wadah = Cells(x, 3).Value & wadah
> Cells(x, 3).Value = wadah
> wadah = ""
> Cells(x, 5).Value = baris
> End If
>
> Next x
>
> End Sub
>
> 2015-05-25 12:52 GMT+07:00 Nang Agus <[email protected]>:
>
> Mungkinkah macro begini?
> Option Explicit
> Sub kopi()
> Dim baris As Integer, tinggi As Integer, x As Integer
> Dim wadah As String
> tinggi = Range("c1000000").End(xlUp).Row
> For x = tinggi To 7 Step -1
> If Cells(x, 1).Value = 0 Then
> wadah = Cells(x, 3).Value & wadah
> Cells(x, 3).Value = ""
> Else
> wadah = Cells(x, 3).Value & wadah
> Cells(x, 3).Value = wadah
> wadah = ""
> End If
> Next x
>
> 2015-05-25 10:11 GMT+07:00 Ahmad Syaifullah Lubis [email protected]
> [belajar-excel] <[email protected]>:
>
>
>
> Dear BeExceller,
>
> Saya mendapatkan data yang cukup membuat saya kewalahan, di mana data2nya
> biasanya hanya 1 baris, tetapi terkadang ada 2 atau 3 baris, sehingga saya
> kerepotan dalam menyatukannya menjadi 1 baris.
> Mohon diberikan macro yang bisa mengatasi masalah saya tsb.
>
> terima kasih,
>
> ASL
>
>
>
>
>    
>

Kirim email ke