您目前已離線,請等候您的網際網路重新連線

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

Office 2003 支援已結束

Microsoft 於 2014 年 4 月 8 日結束對 Office 2003 的支援。此變更已影響您的軟體更新和安全性選項。 瞭解這對您的意義為何且如何持續受保護。

如需本文的 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 IntegerDim 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.CountSheets("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).SelectLoopApplication.ScreenUpdating = TrueMsgBox "Done!"End Sub				

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

下列範例巨集會比較第一份 (主要) 清單和第二份清單,並刪除第二份清單中與主要清單中重複的項目。第一份清單位於 Sheet1 上的範圍 A1:A10。第二份清單位於 Sheet2 上的範圍 A1:A100。若要使用巨集,請選取任一個工作表,再執行巨集。
Sub DelDups_TwoLists()Dim iListCount As IntegerDim 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 iCtrNextApplication.ScreenUpdating = TrueMsgBox "Done!"End Sub				
参考
如需有關如何使用本文中範例程式碼的詳細資訊,請按一下下面的文件編號,檢視「Microsoft 知識庫」中的文件:
290140 How to run the sample code for the Office XP programs from Knowledge Base articles
dups inf XL2002
內容

文章識別碼:291320 - 最後檢閱時間:02/06/2007 07:53:25 - 修訂: 4.0

Microsoft Office Excel 2007, Microsoft Office Excel 2003, Microsoft Excel 2002 Standard Edition

  • kbautomation kbprogramming kbmacro kbdtacode kbhowto KB291320
意見反應