Cara menggunakan makro untuk menghapus duplikat item dalam daftar di Excel 2000

Terjemahan Artikel Terjemahan Artikel
ID Artikel: 240077 - Melihat produk di mana artikel ini berlaku.
Untuk versi Microsoft Excel 2002 artikel ini, Lihat 291320.
Perbesar semua | Perkecil semua

Pada Halaman ini

RINGKASAN

Di Microsoft Excel, Anda dapat membuat makro untuk menghapus duplikat item dalam daftar. Anda juga dapat membuat makro untuk membandingkan dua daftar, dan menghapus item dalam daftar kedua yang juga dalam daftar (utama) yang pertama. Hal ini berguna jika Anda ingin menggabungkan dua daftar yang bersama-sama, atau jika Anda hanya ingin melihat informasi baru.

Artikel ini mencakup sampel Microsoft Visual Basic untuk aplikasi makro)Sub prosedur) yang menunjukkan bagaimana untuk menghapus catatan duplikat dalam satu Daftar (contoh 1), dan bagaimana untuk menghapus catatan duplikat setelah membandingkan satu daftar terhadap lain (contoh 2). Makro ini tidak memerlukan daftar akan diurutkan. Juga, macro menghapus beberapa duplikat, terlepas dari apakah item diduplikasi sekali atau beberapa kali dalam daftar.

INFORMASI LEBIH LANJUT

Microsoft menyediakan contoh pemrograman hanya sebagai ilustrasi, tanpa jaminan apa pun baik tersurat maupun tersirat. Termasuk, namun tidak terbatas pada, jaminan tersirat mengenai kelayakan untuk diperdagangkan atau kesesuaian untuk keperluan tertentu. Artikel ini mengasumsikan bahwa Anda telah terbiasa dengan bahasa pemrograman yang ditunjukkan dan dengan alat yang digunakan untuk membuat dan mendebug prosedur. Teknisi dukungan Microsoft dapat membantu menjelaskan fungsionalitas prosedur tertentu, namun mereka tidak akan memodifikasi contoh untuk memberikan fungsionalitas tambahan atau menyusun prosedur untuk memenuhi persyaratan khusus Anda.

Contoh 1: Menghapus duplikat item dalam satu daftar

Berikut contoh makro mencari satu daftar di kisaran A1:A100 dan menghapus semua duplikat item dalam daftar. Makro ini mensyaratkan bahwa Anda tidak memiliki sel kosong di kisaran daftar. Jika Anda daftar berisi kosong sel, menyortir data dalam urutan menaik sehingga sel kosong semua pada akhir daftar Anda.
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through.
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Sheets("Sheet1").Range("A1").Select
' Loop until end of records.
Do Until ActiveCell = ""
   ' Loop through records.
   For iCtr = 1 To iListCount
      ' Don't compare against yourself.
      ' To specify a different column, change 1 to the column number.
      If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
         ' Do comparison of next record.
         If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
            ' If match is true then delete row.
            Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
               ' Increment counter to account for deleted row.
               iCtr = iCtr + 1
         End If
      End If
   Next iCtr
   ' Go to next record.
   ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
				

Contoh 2: Membandingkan dua daftar dan menghapus duplikat item

Berikut contoh makro membandingkan satu daftar (utama) terhadap Daftar lain, dan menghapus duplikat item dalam daftar kedua yang juga di Daftar utama. Daftar pertama adalah pada Sheet1 di pegunungan A1:A10. Kedua Daftar adalah pada Sheet2 di pegunungan A1:A100. Untuk menggunakan makro, pilih salah satu lembar, dan kemudian jalankan makro.
Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count

' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:A10")
   ' Loop through all records in the second list.
   For iCtr = 1 To iListCount
      ' Do comparison of next record.
      ' To specify a different column, change 1 to the column number.
      If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
         ' If match is true then delete row.
         Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
         ' Increment counter to account for deleted row.
         iCtr = iCtr + 1
      End If
   Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
				

REFERENSI

Untuk informasi lebih lanjut tentang cara menggunakan kode contoh dalam Artikel ini, klik nomor artikel di bawah ini untuk melihat artikel di Basis Pengetahuan Microsoft:
212536OFF2000: Bagaimana untuk menjalankan kode contoh dari artikel Basis Pengetahuan
Note This is a "FAST PUBLISH" article created directly from within the Microsoft support organization. The information contained herein is provided as-is in response to emerging issues. As a result of the speed in making it available, the materials may include typographical errors and may be revised at any time without notice. See Terms of Use for other considerations.

Properti

ID Artikel: 240077 - Kajian Terakhir: 20 September 2011 - Revisi: 2.0
Berlaku bagi:
  • Microsoft Excel 2000 Standard Edition
Kata kunci: 
kbautomation kbprogramming kbdtacode kbhowto kbmt KB240077 KbMtid
Penerjemahan Mesin
PENTING: Artikel ini diterjemahkan menggunakan perangkat lunak mesin penerjemah Microsoft dan bukan oleh seorang penerjemah. Microsoft menawarkan artikel yang diterjemahkan oleh seorang penerjemah maupun artikel yang diterjemahkan menggunakan mesin sehingga Anda akan memiliki akses ke seluruh artikel baru yang diterbitkan di Pangkalan Pengetahuan (Knowledge Base) dalam bahasa yang Anda gunakan. Namun, artikel yang diterjemahkan menggunakan mesin tidak selalu sempurna. Artikel tersebut mungkin memiliki kesalahan kosa kata, sintaksis, atau tata bahasa, hampir sama seperti orang asing yang berbicara dalam bahasa Anda. Microsoft tidak bertanggung jawab terhadap akurasi, kesalahan atau kerusakan yang disebabkan karena kesalahan penerjemahan konten atau penggunaannya oleh para pelanggan. Microsoft juga sering memperbarui perangkat lunak mesin penerjemah.
Klik disini untuk melihat versi Inggris dari artikel ini:240077

Berikan Masukan

 

Contact us for more help

Contact us for more help
Connect with Answer Desk for expert help.
Get more support from smallbusiness.support.microsoft.com