Dear mas Aji,
terima kasih mas Aji sudah berbaik hati melakukan koreksi terhadap script
Jan, tinggal menunggu tanggapan dari pembuat thread apakah solusi yang
ditawarkan sudah sesuai dengan harapan atau tidak.
Best Regard,
-Jan Raisin-
Pada 21 November 2012 18:29, aji mumpung <pupung1...@gmail.com> menulis:
> **
>
>
> mbak Jan,
>
> izin untuk sedikit mengutak-atik script dari mbak Jan ya, agar script
> tersebut dapat berjalan dengan baik di dua buah file dari mr Kid
>
> Option Explicit
> ' --------------------------- '
> ' Code by: Miss Jan Raisin '
> ' untuk millis Belajar Excel '
> ' 21 November 2012 '
> ' Re-coded by: Aji Mumpung '
> ' 21 November 2012 '
> ' --------------------------- '
>
> ' ini adalah nama prosedurnya
> Sub RekapData()
>
> ' deklarasikan variabel bertipe Range untuk menyimpan objek berupa
> range
> ' rgData = range_Data, letaknya di sheet Nota mulai cell H13 samapai
> cell H17
> ' cData = cell_Data, adalah setiap 1 cell di dalam rgData
> Dim rgData, cData As Range
>
> ' deklarasikan variabel untuk menyimpan nomer baris dengan tipe Long
> ' r = nomor baris data pertama di sheet Rekap yaitu baris 7 sampai
> dengan nomer baris terakhir yang ada datanya
> ' data tersebut bisa berupa Null String, atau sebut saja yang nanya
> bikin semacam acara Jebakan Betmen
> ' Brs = nomor baris terakhir yang digunakan, letaknya antah berantah
> ' idxBrs = nomor baris di bawah data yang masih kosong atau Null String
> Dim r, Brs, idxBrs As Long
>
> ' non-aktifkan aplikasi screen update untuk mempercepat kerja macro
> Application.ScreenUpdating = False
>
> ' aktifkan sheet Nota, hal ini untuk berjaga-jaga jika sheet aktif
> bukanlah sheet Nota
> Sheets("Nota").Select
>
> ' tetapkan lokasi rgData, yaitu di sheet Nota >> sudah dipanggil
> sebelumnya
> ' letaknya di cell H13 sampai dengan cell H17
> Set rgData = Range("h13:h17")
>
> ' untuk setiap 1 cell (cData) di dalam rgData
> For Each cData In rgData
>
> ' jika nilai cData <> "" maka
> If cData.Value <> "" Then
>
> ' range cData sampai 8 kolom di sebelah kanan cData dicopy
> ' untuk menunjuk 8 kolom disebelah kanan cData digunakan
> perintah cData.Offset(0, 8)
> ' untuk melakukan copy digunakan perintah .Copy
> Range(cData, cData.Offset(0, 8)).Copy
>
> ' panggil / aktifkan sheet Rekap
> Sheets("Rekap").Select
>
> ' panggil / pergi ke cell A7
> Range("a7").Select
>
> ' saat ini cell aktif berada di cell A7
> ' pada cell aktif cek apakah ada datanya atau tidak
> ' jika pada aktif cell ada datanya, maka
> If ActiveCell.Value <> "" Then
>
> ' hitung nilai baris paling akhir yang berisi data
> ' bisa saja berupa Null String yang letaknya di antah
> berantah
> ' untuk mengetahui letak cell digunakan perintah
> .SpecialCells(xlCellTypeLastCell)
> ' untuk mengetahui nomer barisnya digunakan perintah .Row
> ' lalu nomer baris tersebut disimpan dalam sebuah variabel
> bernama Brs
> Brs = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
>
> ' jika nilai Brs lebih besar dari 7
> ' kenapa harus 7? karena TS meminta data pertama berada di
> cell A7 (kolom A, baris 7)
> ' jika Brs lebih besar dari 7, maka
>
> '
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
> ' penambahan logika untuk seleksi dari :
> '
> ' If Brs > 7 Then
> '
> ' menjadi :
> '
> If Brs > 7 And Cells(Brs, 1).Value = "" Then
> '
> ' tujuannya adalah untuk mengecek apakah pada kolom A
> baris tersebut '
> ' ada datanya atau tidak
> '
> '
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
>
> ' lakukan loop mulai dari baris 7 sampai dengan nomer
> baris yang disimpan dalam variabel Brs
> For r = 7 To Brs
>
> ' lalukan pengecekan kondisi, apakah di baris
> tersebut pada kolom 1 ada datanya atau tidak
> ' untuk menunjukknya menggunakan perintah Cells(r,
> 1)
> ' syntaxnya adalah Cells(nomer_baris , nomer_kolom)
> ' jika pada baris tersebut pada kolom 1 tidak ada
> datanya atau Null Sring, maka
> If Cells(r, 1).Value = "" Then
>
> ' ambil nilai berisnya menggunakan perintah
> .Row
> ' lalu disimpan dalam variabel bernama idxBrs
> idxBrs = Cells(r, 1).Row
>
> ' jika sudah ketemu, lalu keluar dari loop
> Exit For
>
> ' ini adalah akhir dari pengecekan data pada sheet
> Rekap
> End If
>
> ' jika belum ketemu cell dengan data yang kosong, maka
> lanjutkan dengan baris berikutnya
> Next r
>
> ' ini adalah akhir pengecekan jika nilai Brs lebih besar
> dari 7
> End If
>
> '
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
> ' penambahan script untuk pengujian kondisi nilai baris
> '
> ' jika nilai idxBrs = 0, karena tidak memenuhi kriteria
> pengujian di atas '
> ' maka nilai idxBrs yang merupakan baris penulisan data
> berikutnya adalah '
> ' nilai Brs ditambah 1
> '
> ' nilai Brs adalah nilai baris dari data yang terakhir
> '
> If idxBrs = 0 Then
> '
> idxBrs = Brs + 1
> '
> End If
> '
> '
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
>
> ' panggil cell yang terpilih
> ' yaitu nomer baris sesuai nilai yang didapat dalam idxBrs
> dan kolom 1
> Cells(idxBrs, 1).Select
>
> ' ini adalah akhir pengecekan apakah cell A7 di sheet Rekap
> ada datanya atau tidak
> End If
>
> ' pada aktif cell sesuai dengan pengecekan beberapa kondisi di
> atas
> ' dilakukan paste special sesuai dengan nilai dan format data
> asal
> ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
>
> ' setelah itu matikan aplikasi copy paste
> Application.CutCopyMode = False
>
> ' yang ini adalah akhir dari pemeriksaan apakah cData ada datanya
> atau tidak
> End If
>
> ' panggil kembali sheet Nota, karena saat ini yang aktif adalah
> sheet Rekap
> Sheets("Nota").Select
>
> ' lanjutkan untuk setiap cData berikutnya
> Next cData
>
> ' aktifkan aplikasi screen update
> Application.ScreenUpdating = True
>
> ' yang ini adalah akhir dari prosedur
> End Sub
>
> Yang diberi warna merah adalah penambahan dan peng-edit-an yang saya
> lakukan. Insya Allah sekarang script tersebut dapat berjalan dengan baik di
> kedua file, sebelumnya sudah dilakukan uji coba terhadap kedua file
> tersebut.
>
> Wassalam,
>
> -Aji Mumpung-
>
> Pada 21 November 2012 16:14, Jan Raisin <miss.jan.rai...@gmail.com>menulis:
>
> **
>>
>>
>> Dear Be Exceler,
>>
>> maaf, ternyata script dari Jan yang tadi hanya berjalan dengan baik di
>> file Sample.xls, jika ada waktu senggang nanti akan coba Jan perbaiki agar
>> dapat berjalan di kedua file, jika ada Be-Exceler yang ingin memperbaiki
>> script dari Jan, Jan mempersilakan dengan senang hati :)
>>
>> Best Regard,
>>
>> Jan Raisin
>>
>> Pada 21 November 2012 15:34, Jan Raisin <miss.jan.rai...@gmail.com>menulis:
>>
>>
>>>
>
