利用VBA寻找重复选项.docx

一、函数1、将公式 =IF(ISERROR(VLOOKUP(B2,B$1:B1,1,0),重复) 在数据区域后空白列第二行，光标对准右下角成“+”状时将公式拖（或双击）下去，效果如图：2、=COUNTIF(A:A,A1)，大于1 的重复。二、VBA找出一列或一行中没有的重新列出来，用全部的去循环对比需要排除的。Sub 测试()Dim rng As Range, rngs As Range, k%, a, b 定义数据类型：设置对range单元格的引用，和定义K为整形变量，a,b为变体变量。For Each rng In a2:a6 for each外循环的范围 a = rng.Value For Each rngs In b2:b4 for each内循环的范围 b = rngs.Value If rng = rngs Then GoTo 100 跳出外循环 End If Next rngs k = k + 1 Cells(k + 1, c) = rng 把没等的内容复制到新的一列中100:Next rngEnd Sub找出重复的并列出次数：Sub 统计()y1 = 1 开始列为A列（在EXCEL中，A列的列号为1）y2 = 4 结束列为D列（在EXCEL中，D列的列号为4）x = 2n1 = 255 辅助列n2 = y2+2 结果显示列，结果显示在源数据列的右侧，中间间隔一列。For i = y1 To y2s = Cells(65536, y1).End(xlUp).Row 各列数据的数量Range(Cells(1, i), Cells(s, i).Copy Cells(x, n1) 把所有数据复制到辅助列中x = x + sNextCells(1, n1) = 数据: Cells(1, n2 + 1) = 次数使用“高级筛选”功能将不重复数据显示在“结果显示列”中Columns(n1).AdvancedFilter 2, , Cells(1, n2), 1s1 = Cells(65536, n2).End(xlUp).Row下面代码用COUNTIF函数统计重复次数For i = 2 To s1Cells(i, n2 + 1) = WorksheetFunction.CountIf(Columns(n1), Cells(i, n2)Next消除辅助列内容Columns(n1) = End SubSub 按指定次数重复数据()Dim Rng, Arr()Dim i As Integer, j As Integer, k As IntegerDim LastRow As Integer, Total As IntegerLastRow = A65536.End(xlUp).Row 从A列最后一行向上找，找到有数据的行为止Total = Application.WorksheetFunction.Sum(Range(B2:B & LastRow)Rng = Range(A1:B & LastRow)ReDim Arr(1 To Total, 1 To 1) 重新定义数组ARR,调整第一维下标从1起到20止,第二维下标从1起到11止For i = 2 To UBound(Rng, 1) For j = 1 To Rng(i, 2) k = k + 1 Arr(k, 1) = Rng(i, 1) NextNextRange(D2).Resize(k, 1).Value = ArrEnd Sub1. Sub test()2. Dim ar3. Dim d As Object4. Dim i As Integer, j As Integer5. Set d = CreateObject(scripting.dictionary)6. ar = Range(a1).CurrentRegion7. For j = 1 To 38. For i = 2 To UBound(ar)9. If ar(i, j) Then10. d(ar(i, j) = 11. End If12. Next13. Next14. Range(d2:d65536).Clear15. Range(d2).Resize(d.Count, 1).NumberFormatLocal = 16. Range(d2).Resize(d.Count, 1) = Application.Transpose(d.keys)17. End Sub1. Sub Iterance()2. Dim i As Long 定义循环变量i类型为长整型3. For i = 1 To 10 循环10次4. If Application.CountIf(Range(A1:A10), Cells(i, 1) 1 Then Cells(i, 1).Font.Color = 2555. 从第一个单元格开始循环利用工作表函数Countif如果该单元格的值在A1:A10这个区域中的个数大于了1那么就填充字体颜色为红色6. Next7. End Sub8.9. Sub Iterance1() 录制一个条件格式10. Range(A1:A10).FormatConditions.Add Type:=xlExpression, Formula1:= _11. =COUNTIF($A$1:$A$10,A1)112. Range(A1:A10).FormatConditions(1).Interior.Color = 25513. End Sub最近在网上找到了一些比较好的关于AdvancedFilter应用的例子，总结和分享如下： expression.AdvancedFilter(Action,CriteriaRange,CopyToRange,Unique)expression 必需。该表达式返回“应用于”列表中的对象之一。ActionXlFilterAction类型，必需。XlFilterAction 可为以下 XlFilterAction 常量之一。xlFilterCopyxlFilterInPlaceCriteriaRangeVariant类型，可选。条件区域。如果省略本参数，则没有条件限制。CopyToRangeVariant类型，可选。如果Action为xlFilterCopy，则本参数指定被复制行的目标区域。否则忽略本参数。UniqueVariant类型，可选。如果为True，则重复出现的记录仅保留一条；如果为False，则筛选出所有符合条件的记录。默认值为False。例子：（看附件）Sub Macro1() Range(A1:D12).Select Range(A1:D12).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ F5:I6), CopyToRange:=Range(K1), Unique:=FalseEnd Sub总结：在条件设定中：1. 同一行的各条件是“and”的关系2.不同行间是“or”的关系3. 条件列标题要和原来表格的一致4. 在VBA条件范围时要注意，在选定多行范围时，空单元格也是一个条件，如本例，如果只选定“F5：I6”，那只有“F6”and的共同条件，但如果选“F5：I”，而第行为空，则在以上条件下，还要考虑or 的条件 (相当于全选)。Sub 测试()Dim rng As Range, rngs As Range, k%, a, bDim LastRowA As Integer, LastRowB As Integer定义数据类型：设置对range单元格的引用，和定义K为整形变量，a,b为变体变量。LastRowA = A65536.End(xlUp).Row从A列最后一行向上找，找到有数据的行为止LastRowB = B65536.End(xlUp).RowFor Each rng In A2:A & LastRowA外循环的范围 a = rng.Value For Each rngs In B2:B & LastRowB for each内循环的范围 b = rngs.Value If rng = rngs Then GoTo 100 跳出外循环 End If Next rngs k = k + 1 Cells(k + 1, c) = rng 把没等的内容复制到新的一列中100:Next rngEnd Sub正确的：Sub 找出未有项()Dim rng As Range, rngs As Range, lastcellB As Range, lastcellA As Range, k%, a, b 定义数据类型：设置对range单元格的引用，和定义K为整形变量，a,b为变体变量。Set lastcellA = Cells(Rows.Count, a).End(xlUp) 查找最后A列最后一个非空单元格Set lastcellB = Cells(Rows.Count, b).End(xlUp) 查找最后B列最后一个非空单元格For Each rng In Range(A2, lastcellA) a = rng.Value For Each rngs In Range(B2, lastcellB) b = rngs.Value If rng = rngs Then GoTo 100 End If Next rngs k = k + 1 Cells(k + 1, d) = rng100:Next rngEnd Sub清除内容：Sub 清除填写内容() Sheets(Sheet1).Select Range(A2:A65536,B2:B65536,D2:D65536).Select Selection.ClearContents Range(A2).SelectEnd Sub找出重复的：Sub 找出重复项()Dim lastcellA As Range, s1%, iSet lastcellA = Cells(Rows.Count, a).End(xlUp) 查找最后A列最后一个非空单元格Range(A2, lastcellA).Ad