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

Terjemahan Artikel Terjemahan Artikel
ID Artikel: 291320 - Melihat produk di mana artikel ini berlaku.
Perbesar semua | Perkecil semua

Pada Halaman ini

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 memerlukan bahwa Anda tidak memiliki sel kosong di kisaran daftar. Jika Anda daftar berisi sel kosong, menyortir data dalam urutan menaik sehingga sel kosong semua di akhir daftar.
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 yang lain, dan menghapus duplikat item dalam daftar kedua yang juga dalam daftar utama. Daftar pertama adalah pada Sheet1 di pegunungan A1:A10. Daftar kedua 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:
290140Bagaimana menjalankan kode contoh dari artikel Basis Pengetahuan

Properti

ID Artikel: 291320 - Kajian Terakhir: 23 September 2011 - Revisi: 2.0
Berlaku bagi:
  • Microsoft Office Excel 2007
  • Microsoft Excel 2002 Standard Edition
  • Microsoft Office Excel 2003
  • Microsoft Excel 2010
Kata kunci: 
kbautomation kbprogramming kbmacro kbdtacode kbhowto kbmt KB291320 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:291320

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