利用Excel内嵌的搜索技术来实现高速查找重复值.doc

利用Excel内嵌的搜索技术来实现高速查找重复值时间:2009-06-16 18:41:34来源:网络 作者:未知 点击:0次 Excel中可以实现搜索文本的功能，内嵌的优秀搜索算法可以快速的查找并定位一个特定的文本单元格，今天我使用VBA写了几行代码，实现了一个自动搜索并定位行功能的小程序！发现了Excel的这个优秀的属性，速度简直超级快！于是很快，Excel中可以实现搜索文本的功能，内嵌的优秀搜索算法可以快速的查找并定位一个特定的文本单元格，今天我使用VBA写了几行代码，实现了一个自动搜索并定位行功能的小程序！发现了Excel的这个优秀的属性，速度简直超级快！于是很快，我就有了一个新想法，升级重复值校验程序的版本到V4.0！就使用Excel的这个属性来实现！于是乎说到不如做到！开始.，下面就公布这段代码，与各位网友共同研究：* 全局查找资产号重复数据程序v4.0该程序通过遍历所有工作表查找表计资产号重复数据,将重复数据值拷贝到另一个工作表中并标注位置信息,重复值高亮显示,注意：该代码必须放到ThisWorkbook中执行,首尾设断点*Public Sub FindAssetRepeat() 遍历查找资产号重复数据Debug.Print 开始时间 & Format(Now, yyyy年mm月dd日hh时mm分ss秒)Dim i As Long, j As Long, k As Long, l As Long, m As Long, oi As LongDim maintemp As String, AssetColName As StringDim ws As Worksheet, obj As Object, temprow As Longoi = 1 标记结果工作表中初始的写入行号AssetColName = E 标识资产号所在的列的列名,如果档案的格式不同,可以修改该值*初始化重复值结果工作表开始For i = 1 To Worksheets.Count 先判断重复值结果工作表是否存在,如果存在则将句柄传给ws,并初始化 If Worksheets(i).Name = 重复值结果 Then Set ws = Worksheets(i) ws.Move After:=Sheets(Worksheets.Count) ws.Cells.Select Selection.Delete Shift:=xlUp GoTo toBegin End IfNext iSet ws = Worksheets.Add(After:=Sheets(Worksheets.Count)ws.Name = 重复值结果toBegin:ws.Activatews.Range(A & oi & :N & oi).Selectws.Range(A & oi & :N & oi).Mergews.Range(A & oi & :N & oi).Value = 表计资产号重复数据列表ws.Range(O & oi).Value = 备注oi = oi + 1ws.Cells.SelectSelection.NumberFormatLocal = ws.Cells(1, 1).Select初始化重复值结果工作表结束*遍历所有表,开始查找重复值For i = 1 To Worksheets.Count - 1 For j = 2 To Worksheets(i).UsedRange.Rows.Count - 1 maintemp = Trim(Worksheets(i).Range(AssetColName & j).Value) If maintemp = Then GoTo toNextRow 如果其他工作表中的被校验行的资产号是非法数据,则跳到下一条 If Asc(Left(maintemp, 1) 255 Then GoTo toNextRow 功能同上 * 在当前工作表中查找重复值开始 Worksheets(i).Activate Worksheets(i).Range(AssetColName & j + 1 & : & AssetColName & Worksheets(i).UsedRange.Rows.Count).SelecttoBeginSearch1: Set obj = Selection.Find(What:=maintemp, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False) If Not (obj Is Nothing) Then obj.Activate temprow = ActiveCell.Row ws.Activate ws.Range(A & oi & :L & oi).Value = Worksheets(i).Range(A & j & :L & j).Value ws.Range(A & oi + 1 & :L & oi + 1).Value = Worksheets(i).Range(A & temprow & :L & temprow).Value ws.Range(M & oi).Value = Worksheets(i).Name & 表中第 & j & 行 ws.Range(M & oi + 1).Value = Worksheets(i).Name & 表中第 & temprow & 行 ws.Range(N & oi & :N & oi + 1).Select ws.Range(N & oi & :N & oi + 1).Merge ws.Range(N & oi & :N & oi + 1).Value = 两行数据资产号重复 ws.Range(AssetColName & oi & : & AssetColName & oi + 1).Select Selection.Interior.ColorIndex = 3 oi = oi + 3 If temprow Worksheets(i).UsedRange.Rows.Count - 1 Then Worksheets(i).Activate Worksheets(i).Range(AssetColName & temprow + 1 & : & AssetColName & Worksheets(i).UsedRange.Rows.Count).Select GoTo toBeginSearch1 End If End If 在当前工作表中查找重复值结束 * 在其他工作表中查找重复值开始 For l = i + 1 To Worksheets.Count - 1 Worksheets(l).Activate Worksheets(l).Range(AssetColName & : & AssetColName).SelecttoBeginSearch2: Set obj = Selection.Find(What:=maintemp, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False) If Not (obj Is Nothing) Then obj.Activate temprow = ActiveCell.Row ws.Activate ws.Range(A & oi & :L & oi).Value = Worksheets(i).Range(A & j & :L & j).Value ws.Range(A & oi + 1 & :L & oi + 1).Value = Worksheets(l).Range(A & temprow & :L & temprow).Value ws.Range(M & oi).Value = Worksheets(i).Name & 表中第 & j & 行 ws.Range(M & oi + 1).Value = Worksheets(l).Name & 表中第 & temprow & 行 ws.Range(N & oi & :N & oi + 1).Select ws.Range(N & oi & :N & oi + 1).Merge ws.Range(N & oi & :N & oi + 1).Value = 两行数