Bagian penulis nomor urut record ini :
r = Sheets("DATA PENJUALAN").Range("I1").CurrentRegion.Rows.Count - 1
Sheets("DATA PENJUALAN").Range("I1").Select
For i = Cells(9, 9) To r
ActiveCell = i
ActiveCell.Offset(1, 0).Select
Next i
Range("I1").FormulaR1C1 = "No"
Bisa diganti menjadi :
dim i as long
with Sheets("DATA PENJUALAN")
i=.Range("I1").CurrentRegion.Rows.Count - 1
.range("i2").resize(i).value=evaluate("=row(1:" & i & ")")
.range("i1").value="No"
end with
Bagian sort descending ini :
Columns("A:I").Select
ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort.SortFields.CLEAR
ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort.SortFields.Add
Key:=Range( _
"I:I"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort
.SetRange Range("A:I")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Bisa diubah menjadi :
with Sheets("DATA PENJUALAN").range("a1:i1").currentregion
.sort .cells(1,9) , xldescending , header:=xlyes ,
orientation:=xlsortcolumns
end with
*** ganti xldescending menjadi xlascending untuk part sort ascending
setelah removeduplicate
Bagian remove duplicate ini :
ActiveSheet.Range("A:I").RemoveDuplicates Columns:=Array(3, 4), _
Header:=xlYes
Bisa diubah menjadi :
Sheets("DATA PENJUALAN").range("a1:i1").currentregion.removeduplicates
array(3,4) , xlyes
Bila perlu, tambahkan tepat setelah baris dim sebelum proses tulis nomor
urut bunyi berikut :
application.screenupdating=false
dan tepat sebelum end sub bunyi berikut :
application.screenupdating=true
Wassalam,
Kid
2015-08-21 18:17 GMT+07:00 Ivan Sebastian [email protected]
[belajar-excel] <[email protected]>:
>
>
> --- Mods ---
> File lampiran lebih dari 250KB dilepas dari email. Silakan pemosting
> melakukan posting file lampiran yang diusahakan maksimal 250KB dengan cara
> me-reply email ini.
> ---------------
>
> terima kasih mr kid...
> saya sudah berhasil memodif formula yg menurut saya ini yg paling sesuai
> makronya... waktu yg dibutuhkan untuk meremove data kembar dan menyisakan
> data paling baru dalam ribuan data cuman 3dtk kurang lebihnya...
> makro saya seperti ini.. bilamana ada yg janggal menurut mr kid.. mohon
> bantuan dan bimbingannya untuk perbaikan dari rumus ini.. karena saya cuman
> bermodal coba2 modif sendiri...
>
> Sub CommandButton2_Click()
> Application.ScreenUpdating = False
> Application.Calculation = xlCalculationManual
> Columns("I:I").EntireColumn.Hidden = False
>
> r = Sheets("DATA PENJUALAN").Range("I1").CurrentRegion.Rows.Count - 1
> Sheets("DATA PENJUALAN").Range("I1").Select
> For i = Cells(9, 9) To r
> ActiveCell = i
> ActiveCell.Offset(1, 0).Select
> Next i
> Range("I1").FormulaR1C1 = "No"
>
> Columns("A:I").Select
> ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort.SortFields.CLEAR
> ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort.SortFields.Add
> Key:=Range( _
> "I:I"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
> xlSortNormal
> With ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort
> .SetRange Range("A:I")
> .Header = xlYes
> .MatchCase = False
> .Orientation = xlTopToBottom
> .SortMethod = xlPinYin
> .Apply
> End With
> ActiveSheet.Range("A:I").RemoveDuplicates Columns:=Array(3, 4), _
> Header:=xlYes
> ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort.SortFields.CLEAR
> ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort.SortFields.Add
> Key:=Range( _
> "I:I"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
> xlSortNormal
> With ActiveWorkbook.Worksheets("DATA PENJUALAN").Sort
> .SetRange Range("A:I")
> .Header = xlYes
> .MatchCase = False
> .Orientation = xlTopToBottom
> .SortMethod = xlPinYin
> .Apply
> End With
>
> Range("I:I").ClearContents
> Range("I1").FormulaR1C1 = "No"
> Columns("A:H").Select
> Selection.Borders(xlDiagonalDown).LineStyle = xlNone
> Selection.Borders(xlDiagonalUp).LineStyle = xlNone
> With Selection.Borders(xlEdgeLeft)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlEdgeTop)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlEdgeBottom)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlEdgeRight)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlInsideVertical)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> With Selection.Borders(xlInsideHorizontal)
> .LineStyle = xlContinuous
> .ColorIndex = 0
> .TintAndShade = 0
> .Weight = xlThin
> End With
> Application.Calculation = xlCalculationAutomatic
> Application.ScreenUpdating = True
> Columns("I:I").EntireColumn.Hidden = True
> End Sub
>
>
>
>
>
> Pada Jumat, 21 Agustus 2015 1:50, "'Mr. Kid' [email protected]
> [belajar-excel]" menulis:
>
>
>
> Untuk menulis nomor baris dengan baris kode :
> 'misal pada nomor baris diletakkan di K11:K19 (ada 9) baris, nomor mulai
> dari 1
> sheets("nama sheet target").range("k11:k19").value=evaluate("=Row(1:9)")
>
> Andai menggunakan fitur Excel Table, maka penulisan nomor baris tidak
> diperlukan.
> Contoh ada tabel data dengan kolom dari A sampai D, header di baris 1
> (range A1:D1), data mulai A2.
> Di kolom E diberi header (range E1) NomorBaris. Dengan cell E2 berisi
> formula =Row()-1
> Langkah pertama (cukup dijalankan sekali saja) adalah membuat object Excel
> table. Caranya blok A1 sampai kolom E baris terakhir data (kolom berformula
> nomor baris ikut terblok). Kemudian ribbon Home -> group Styles -> format
> as table -> pilih salah satu styles yang ada.
>
> Setiap kali ada data baru, paste-kan dibaris kosong pertama (tidak boleh
> ada baris kosong antar data). Pastikan data yang dipaste hanya berisi 4
> kolom karena header kolom pokok ada di A sampai D dan kolom E adalah
> tambahan.
> Kemudian langkah remove duplicate nya adalah :
> 1. sort kolom E secara descending (largest to smallest)
> 2. lakukan remove duplicate (centang kolom yang menjadi kunci unique
> records, dan pastikan kolom E tidak dicentang)
> 3. jika muncul kotak pesan bahwa tidak ada data yang di-remove atau tidak
> ada yang duplicate, maka lakukan sort lagi secara descending. Tapi jika
> kotak pesan yang muncul menunjukkan ada sekian record yang di remove, maka
> tidak perlu sort lagi.
>
> Jika ternyata kolom data yang dipaste bisa berubah-ubah jumlahnya, maka
> dibalik posisinya.
> Kolom A berisi formula =Row()-1, dan data pokok dipaste mulai kolom B.
>
> Wassalam,
> Kid
>
>
>
>
>
>
>
>
>
>
>
>
> 2015-08-18 10:14 GMT+07:00 Ivansl [email protected] [belajar-excel] <
> [email protected]>:
>
>
> Terima kasih atas sarannya mr kid... Sudah saya ikutin langkah2nya.. Dan
> sudah saya record ke dalam bentuk makro.. Cuman muncul satu permasalahan
> lg.. Bagaimana supaya no urut baris tiap kali ada data record terbaru
> otomatis no urut terisi dengan sendirinya? Apa harus manual terus untuk
> pengisian nomer urut baris??
>
>
>
> On 18 Agt 2015, at 05.10, 'Mr. Kid' [email protected] [belajar-excel] <
> [email protected]> wrote:
>
>
> Hai Layonardo,
>
> Fitur remove duplicate selalu membuang record yang lebih bawah. Jadi,
> ketika bisa membuat urutan record menjadi terbalik sesaat saja, maka fitur
> ini bisa digunakan.
>
> Biasanya data histori memiliki kolom last update berisi tanggal dan waktu
> si record ditulis ke dalam tabel. Fitur remove duplicate bisa digunakan
> dengan didahului proses pengurutan data secara menurun (descending)
> berdasar kolom last update ini. Kemudian mengembalikan lagi urutannya
> menjadi menaik (ascending) berdasar kolom last update, jika dituntut bahwa
> unique records yang masuk ke dalam tabel yang terbaru tetap di baris yang
> bawah.
>
> Andaikan tabel tidak memiliki kolom berisi tanggal dan waktu last update,
> maka diperlukan pembuatan kolom baru di kanan tabel data (rapat dengan
> kolom terakhir data) yang diisi dengan nomor baris record (bisa mulai dari
> 1 ataupun dari angka berapa saja asal berurut). Langkahnya begini :
> 1. Misal diberi header bernama Baris.
> 2. Lalu di record ke-1 diisi angka 1, dan record ke-2 diisi angka 2.
> 3. blok angka 1 dan 2 yang di-input di no 2 -> gerakkan mouse ke pojok
> kanan bawah sampai icon berubah menjadi + hitam padat -> double click mouse
> -> periksa bahwa seluruh record sudah memiliki nomor urut.
> 4. Blok seluruh tabel (header, semua kolom termasuk kolom baru ini,
> seluruh baris)
> 5. sort berdasar kolom baru bernama Baris secara Descending
> 6. lakukan remove duplicate berdasar kolom-kolom kunci (pastikan kolom
> Baris bukan menjadi kunci dalam remove duplicate)
> 7. sort lagi berdasar kolom baru bernama Baris secara Ascending.
>
> Proses diatas bisa
>
> Wassalam,
> Kid
>
>
>
>
> 2015-08-17 23:40 GMT+07:00 [email protected] [belajar-excel] <
> [email protected]>:
>
>
> dear all master... mohon bantuan untuk rumus makronya...
> langsung ke topiknya.. saya pingin menghapus data kembar.dan menyisakan
> data yg paling baru...
> sebenarnya cara paling cepat adalah pakai remove duplikat dari bawaan
> excel sendiri cuman sayangnya... data yg dihapus malah yg terbaru... dan
> menyisakan data yg lama saja... nah yg saya inginkan justru sebaliknya...
>
> data saya lampirkan.. bisa langsung di cek ke bagian sheet "data
> penjualan".. disana saya siapkan 1 tombol hapus dan saya ingin hasilnya
> seperti di sheet "contoh hasil tombol hapus" mohon bantuannya... semoga
> paham maksud saya...
>
> saya ada nemu rumus makro ini cuman bilamana datanya mencapai 5000an or
> lebih dari itu.. prosesnya memakan waktu yg cukup lama sekitar 2-3 menit..
> yg mana menurut saya cukup lama... sebaliknya rumus bawaan excelnya(remove
> duplikat) malah lebih cepat... bahkan ga sampe 30 dtk...
>
> Sub hapus()
>
> Dim brs As Long
>
> Dim i As Long
>
> Dim j As Long
>
> Dim ROW_DELETED As Boolean
>
> brs = WorksheetFunction.CountA(ActiveSheet.Range("A:A")) - 1
>
> Application.ScreenUpdating = False
>
> For x = 1 To brs
>
> ActiveSheet.Range("Q" x + 1).Value = ActiveSheet.Range("C" x + 1).Value
> ActiveSheet.Range("D" x + 1).Value
>
> Next x
>
> i = 2
>
> Do While i <= ActiveSheet.UsedRange.Rows.Count
>
> ROW_DELETED = False
>
> For j = i + 1 To ActiveSheet.UsedRange.Rows.Count
>
> If Cells(i, 17) = Cells(j, 17) Then
>
> Rows(i).Delete
>
> ROW_DELETED = True
>
> Exit For
>
> End If
>
> Next j
>
> If Not ROW_DELETED Then i = i + 1
>
> Loop
>
> For x = 1 To brs
>
> ActiveSheet.Range("Q" x + 1).ClearContents
>
> Next x
>
> Application.ScreenUpdating = True
>
> End Sub
>
> --- Mods ---
> File lampiran yang lebih dari 250KB dilepas dari postingan. Silakan
> penanya melampirkan ulang file yang diusahakan maksimal 250KB dengan cara
> me-reply email ini.
> ----------------
>
>
>
>
>
>
>
