--- 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]
mailto:[email protected] [belajar-excel] <[email protected]
mailto:[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]
mailto:[email protected] [belajar-excel] <[email protected]
mailto:[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] mailto:[email protected]
[belajar-excel] <[email protected]
mailto:[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.
----------------
