如何使用巨集範例刪除 Excel 中之清單上重複的項目

文章翻譯 文章翻譯
文章編號: 291320 - 檢視此文章適用的產品。
如需本文的 Microsoft Excel 2000 版本,請參閱 240077
全部展開 | 全部摺疊

在此頁中

結論

您可以在 Microsoft Excel 中建立巨集,以選取清單中重複的項目。您也可以建立巨集以比較兩份清單,並刪除第二份清單當中與第一份 (主要) 清單重複的項目。如果您想要合併兩份清單,或者只想要查看新的資訊,此功能很有用。

本文包含 Microsoft Visual Basic for Applications 巨集 (Sub 程序) 的範例,這些範例會示範如何刪除單一清單中重複的記錄 (範例 1),以及如何在比較兩份清單後刪除重複的記錄 (範例 2)。使用這些巨集時,清單不需要排序。另外,不論項目在清單中是重複一次或許多次,這些巨集會刪除所有重複的項目。

其他相關資訊

Microsoft 僅提供示範性的程式設計範例,不做任何明示或默示的保證。其中包括 (但不限於) 其適售性與適合某特定用途之默示擔保。本文將假設您已相當熟悉示範所使用的程式設計語言,以及用於建立和偵錯程序的工具。Microsoft 技術支援工程師可以協助說明特定程序的功能,但不會修改這些範例以提供附加功能或建構程序來滿足您的特定需求。

範例 1:刪除單一清單中的重複項目

下列範例巨集會搜尋 A1:A100 範圍中的單一清單,並刪除清單中所有重複的項目。此巨集要求清單範圍中不能有空白的資料格。如果您的清單有包含空白資料格,請依遞增順序將資料排序,讓空白資料格都位於清單的最後面。
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
				

範例 2:比較兩份清單,並刪除重複的項目

下列範例巨集會比較第一份 (主要) 清單和第二份清單,並刪除第二份清單中與主要清單中重複的項目。第一份清單位於 Sheet1 上的範圍 A1:A10。第二份清單位於 Sheet2 上的範圍 A1:A100。若要使用巨集,請選取任一個工作表,再執行巨集。
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
				

?考

如需有關如何使用本文中範例程式碼的詳細資訊,請按一下下面的文件編號,檢視「Microsoft 知識庫」中的文件:
290140 How to run the sample code for the Office XP programs from Knowledge Base articles

屬性

文章編號: 291320 - 上次校閱: 2007年2月6日 - 版次: 4.0
這篇文章中的資訊適用於:
  • Microsoft Office Excel 2007
  • Microsoft Office Excel 2003
  • Microsoft Excel 2002 Standard Edition
關鍵字:?
kbautomation kbprogramming kbmacro kbdtacode kbhowto KB291320
Microsoft及(或)其供應商不就任何在本伺服器上發表的文字資料及其相關圖表資訊的恰當性作任何承諾。所有文字資料及其相關圖表均以「現狀」供應,不負任何擔保責任。Microsoft及(或)其供應商謹此聲明,不負任何對與此資訊有關之擔保責任,包括關於適售性、適用於某一特定用途、權利或不侵權的明示或默示擔保責任。Microsoft及(或)其供應商無論如何不對因或與使用本伺服器上資訊或與資訊的實行有關而引起的契約、過失或其他侵權行為之訴訟中的特別的、間接的、衍生性的損害或任何因使用而喪失所導致的之損害、資料或利潤負任何責任。

提供意見

 

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