[belajar-excel] Digest Number 3541

Milis Belajar Microsoft Excel Group

3 Messages

Digest #3541

1a

Re: Loop tidak bisa berhenti [1 Attachment] by "Toby kenzo" tobykenzo

2a

menghapus data kembar dan menyisakan data yg paling baru... by layonardo

2b

Re: menghapus data kembar dan menyisakan data yg paling baru... by "Mr. Kid" nmkid.family@ymail.com

Messages

1a

Re: Loop tidak bisa berhenti [1 Attachment]

Mon Aug 17, 2015 2:47 am (PDT) . Posted by:

"Toby kenzo" tobykenzo

Dear Ratri,

Mungkin file ini bisa membantu.

It's work in Office 2013.

TerimaKasih.

Sent from Yahoo Mail on Android

Reply to sender . Reply to group . Reply via Web Post . All Messages (2) . Top ^

2a

menghapus data kembar dan menyisakan data yg paling baru...

Mon Aug 17, 2015 2:46 pm (PDT) . Posted by:

layonardo

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.
----------------

Reply to sender . Reply to group . Reply via Web Post . All Messages (2) . Top ^

2b

Re: menghapus data kembar dan menyisakan data yg paling baru...

Mon Aug 17, 2015 3:10 pm (PDT) . Posted by:

"Mr. Kid" nmkid.family@ymail.com

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 layonardo@yahoo.co.id [belajar-excel] <
belajar-excel@yahoogroups.com>:

>
>
> 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.
> ----------------
>
>
>
>

Reply to sender . Reply to group . Reply via Web Post . All Messages (2) . Top ^

============================================================
Pojok Lowongan Kerja yang disediakan milis :
http://milis-belajar-excel.1048464.n5.nabble.com/Pojok-Lowongan-Kerja-f5725753.html
*** Posting lowongan kerja : ke link tersebut dan klik New Topic
============================================================
bergabung ke milis (subscribe), kirim mail kosong ke: belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke: belajar-excel@yahoogroups.com
berkunjung ke web milis : http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran : http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di : http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe), kirim mail kosong ke : belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------

Visit Your Group

• New Members 4

• Privacy • Unsubscribe • Terms of Use