《利用VBA寻找重复选项》由会员分享，可在线阅读，更多相关《利用VBA寻找重复选项（8页珍藏版）》请在金锄头文库上搜索。
1、一、函数1、将公式=IF(ISERROR(VLOOKUP(B2,B$1:B1,1,0),重复)在数据区域后+”状时将公式拖(或双击)下去，效果如2、=C0UNTIF(A:A,A1),大于 1 的重复。l_mlV .-It l=l=J L4=5 T 7卜安全皆脅隧洒*Bl- 爲二COUMTIFS;丸 A1)AB.GD112.2221331412-5牙26432723184321书421104-3.211IS13、VBA找出一列或一行中没有的重新列出来，用全部的去循环对比需要排除 的。Sub 测试()Dim rng As Range, rngs As Range, k%, a, b 定义数据类型：
2、设置对 range 单元格的引用，和定 义K为整形变量，a,b为变体变量。For Each rng In a2:a6 for each 外循环的范围a = rng.ValueFor Each rngs In b2:b4 for each 内循环的范围b = rngs.ValueIf rng = rngs ThenGoTo 100 跳出外循环End IfNext rngsk = k + 1Cells(k + 1, c) = rng 把没等的内容复制到新的一列中100:Next rngEnd Sub找出重复的并列出次数：Sub 统计()y1 = 1 开始列为A列(在EXCEL中，A列的列号为1)y
3、2 = 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).Advance
4、dFilter 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, Tot
5、al 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 + 1Arr(k, 1) = Rng
6、(i, 1)NextNextRange(D2).Resize(k, 1).Value = ArrEnd Sub1. Sub tes t()2. Dim ar3. Dim d As Object4. Dim i As Integer, j As Integer5. Set d = CreateObject( scripting.dictionary)6.7.&9.10.11.12.13.14.15.16.ar = Range(al).CurrentRegionFor j = 1 To 3For i = 2 To UBound(ar)ThenIf ar(i, j) Then d(ar(i, j)=
7、End IfNex tNex tRange(d2:d65536).ClearRange(d2).Resize(d.Cou nt, l).NumberForma tLocal = Range(d2).Resize(d.Cou nt, 1)二 Applica tio n.Transpose(d.keys)17. End Sub1. Sub It erance()2. Dim i As Long定义循环变量i类型为长整型3. For i = 1 To 10 循环 10 次4. If Application.CountIf(Range(Al:A10), Cells(i, 1) 1 Then Cells
8、(i, l).Font .Color = 2555. 从第一个单元格开始循环利用工作表函数Countif如果该单元格的值 在A1:A10这个区域中的个数大于了 1那么就填充字体颜色为红色6. Next7. End Sub&9. Sub It erance1()录制一个条件格式10. Range(A1:A10).FormatConditions.Add Type:=xlExpression, Formula1:= _11. =C0UNTIF($A$l:$A$10,Al)l12. Range(A1:A10).FormatConditions(1) .Interior.Color = 25513.
9、End Sub最近在网上找到了一些比较好的关于AdvancedFilter应用的例子，总结和分享如下： expressionAdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)expression 必需。该表达式返回应用于列表中的对象之一。Action XlFilterAction 类型，必需。XlFilterAction 可为以下 XlFilterAction 常量之一。xlFilterCopyxlFilterInPlaceCriteriaRange Variant 类型，可选。条件区域。如果省略本参数，则没有条件限制。Copy
10、ToRange Variant类型，可选。如果Action为xlFilterCopy，则本参数指定被复制行的目标区域。否则忽略本参数。Unique Variant类型，可选。如果为True,则重复出现的记录仅保留一条；如果 为False，则筛选出所有符合条件的记录。默认值为False。例子： （看附件）逻询蓟给晟搖笊按啊2ab1/1.212172/2010abbbcc挽下看廿這地IE肥汕i沖填如口1/2/2010煌阳白闻1炖戌切1/5/20102/2/50105f5f2Q3S/5/JJJ-JvaluelegoaISflOTleafla1帥闵l的胸2仙個测(10Uodovalue150OT1MM
11、1別的20(MWdate-Tiwn；Cctnosr.血带1务件2datedart etFP-2CI&-1-1-20LD-2-20175/2014bL-CcjmandCLjizt m17対加皿打芥2山ii1心.如10Sub Macro1()Range(Al:D12).SelectRange(Al:D12).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(F5:I6), CopyToRange:=Range(K1), Unique:=FalseEnd Sub总结：在条件设定中：1.同一行的各条件是“and”的关系2不同行间是“or
12、”的关系3. 条件列标题要和原来表格的一致4. 在VBA条件范围时要注意，在选定多行范围时，空单元格也是一个条件，如本例，如果只选定“F5： 16”，那只有“F6”andG6的共同条件，但如果选“F5： 17”，而第7行为空，则在以上条件下，还要考虑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).
13、Row从 A 列最后一行向上找，找到有数据的行为止LastRowB = B65536.End(xlUp).RowFor Each rng In A2:A & LastRowA 外循环的范围a = rng.ValueFor Each rngs In B2:B & LastRowB for each 内循环的范围b = rngs.ValueIf rng = rngs ThenGoTo 100 跳出外循环End IfNext rngsk = k + 1Cells(k + 1, c) = rng 把没等的内容复制到新的一列中100:Next rngEnd Sub正确的：Sub 找出未有项()Dim r
14、ng 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.ValueFor Each rngs In Range(B2, lastcellB)b = rngs.ValueIf rng = rngs Then
