Microsoft VBA Excel 去重小工具

问题简述

在本工作表中，A1:B3单元格样式如下，通过名称管理器B列的单元格被命名为"LinkFile"、“SheetName”、“InputArea”，请实现以下功能：读取Excel文件中的数据，去除重复的数据，并记录每个数据项最后一次出现的位置，最后将结果输出到当前工作表中。

	A	B
1	Link File:
2	Sheet Name:
3	Input Area:

---

代码描述

第一步：
读取：输入一个xls表格文件的地址到"LinkFile"、该文件内工作表名称到"SheetName"和需要读取数据的范围（例如A2：A102）到"InputArea"，根据指定范围在该文件内指定工作表中读取所有数据；
第二步：
去重和获得索引：上一步获取的数据中存在重复，因此只需要保留唯一值，根据唯一值获得该值最后一次出现在读取数据范围的行列位置信息；
第三步：
输出：在本工作表中，在"InputArea"单元格下两行开始输出从上一步得到的单元格数据和对应的行列信息，也就是从A5开始输入单元格数据，B5开始输入对应的行列信息。

Sub ProcessData()Dim srcWb As WorkbookDim ws As Worksheet, srcWs As WorksheetDim linkFile As String, sheetName As String, inputArea As StringDim rng As Range, cell As RangeDim dict As ObjectDim outputRow As Long' 创建字典来存储唯一值和对应的最后位置Set dict = CreateObject("Scripting.Dictionary")' 获取当前活动的工作表Set ws = ThisWorkbook.ActiveSheet' 读取工作表中的相关数据linkFile = ws.Range("LinkFile").ValuesheetName = ws.Range("SheetName").ValueinputArea = ws.Range("InputArea").Value' 打开源数据文件Set srcWb = Workbooks.Open(linkFile)Set srcWs = srcWb.Sheets(sheetName)' 获取指定范围Set rng = srcWs.Range(inputArea)' 遍历范围，收集数据For Each cell In rngIf Not dict.Exists(cell.Value) Thendict.Add cell.Value, cell.Address(False, False)Elsedict(cell.Value) = cell.Address(False, False)  ' 更新为最后出现的位置End IfNext cell' 关闭源数据文件srcWb.Close False' 输出结果outputRow = ws.Range("InputArea").Row + 2For Each key In dict.Keysws.Cells(outputRow, 1).Value = keyws.Cells(outputRow, 2).Value = dict(key)outputRow = outputRow + 1NextMsgBox "数据处理完毕!"
End Sub

English:

Sub ProcessData()Dim srcWb As WorkbookDim ws As Worksheet, srcWs As WorksheetDim linkFile As String, sheetName As String, inputArea As StringDim rng As Range, cell As RangeDim dict As ObjectDim outputRow As Long' Create a dictionary to store unique values and corresponding last positionsSet dict = CreateObject("Scripting.Dictionary")' Get the currently active worksheetSet ws = ThisWorkbook.ActiveSheet' Read relevant data from the worksheetlinkFile = ws.Range("LinkFile").ValuesheetName = ws.Range("SheetName").ValueinputArea = ws.Range("InputArea").Value' Open the source data fileSet srcWb = Workbooks.Open(linkFile)Set srcWs = srcWb.Sheets(sheetName)' Get the specified rangeSet rng = srcWs.Range(inputArea)' Iterate over the range, collecting dataFor Each cell In rngIf Not dict.Exists(cell.Value) Thendict.Add cell.Value, cell.Address(False, False)Elsedict(cell.Value) = cell.Address(False, False)  ' Update to the last position of occurrenceEnd IfNext cell' Close the source data filesrcWb.Close False' Output the resultsoutputRow = ws.Range("InputArea").Row + 2For Each key In dict.Keysws.Cells(outputRow, 1).Value = keyws.Cells(outputRow, 2).Value = dict(key)outputRow = outputRow + 1NextMsgBox "Data processed successfully!"
End Sub

---

总结