利用VBA寻找重复选项

-.z.一、函数1、将公式=IF(ISERROR(VLOOKUP(B2,B$1:B1,1,0)),"","重复")在数据区域后空白列第二行，光标对准右下角成“+〞状时将公式拖〔或双击〕下去，效果如图：2、=COUNTIF(A:A,A1)，大于1的重复。二、VBA找出一列或一行中没有的重新列出来，用全部的去循环比照需要排除的。Sub测试()DimrngAsRange,rngsAsRange,k%,a,b定义数据类型：设置对range单元格的引用，和定义K为整形变量，a,b为变体变量。ForEachrngIn[a2:a6]foreach外循环的围a=rng.ValueForEachrngsIn[b2:b4]foreach循环的围b=rngs.ValueIfrng=rngsThenGoTo100跳出外循环EndIfNe*trngsk=k+1Cells(k+1,"c")=rng把没等的容复制到新的一列中100:Ne*trngEndSub找出重复的并列出次数：Sub统计()

y1=1'开场列为A列〔在E*CEL中，A列的列号为1〕y2=4'完毕列为D列〔在E*CEL中，D列的列号为4〕*=2

n1=255'辅助列n2=y2+2'结果显示列，结果显示在源数据列的右侧，中间间隔一列。Fori=y1Toy2

s=Cells(65536,y1).End(*lUp).Row'各列数据的数量Range(Cells(1,i),Cells(s,i)).CopyCells(*,n1)'把所有数据复制到辅助列中*=*+s

Ne*t

Cells(1,n1)="数据":Cells(1,n2+1)="次数"

'使用“高级筛选〞功能将不重复数据显示在“结果显示列〞中Columns(n1).AdvancedFilter2,,Cells(1,n2),1

s1=Cells(65536,n2).End(*lUp).Row

'下面代码用COUNTIF函数统计重复次数Fori=2Tos1

Cells(i,n2+1)=WorksheetFunction.CountIf(Columns(n1),Cells(i,n2))

Ne*t

'消除辅助列容Columns(n1)=""

EndSubSub按指定次数重复数据()

DimRng,Arr()

DimiAsInteger,jAsInteger,k

AsInteger

DimLastRowAsInteger,TotalAsInteger

LastRow=[A65536].End(*lUp).Row'从A列最后一行向上找，找到有数据的行为止

Total=Application.WorksheetFunction.Sum(Range("B2:B"&LastRow))

Rng=Range("A1:B"&LastRow)

ReDimArr(1ToTotal,1To1)'重新定义数组ARR,调整第一维下标从1起到20止,第二维下标从1起到11止

Fori=2ToUBound(Rng,1)

Forj=1ToRng(i,2)

k=k+1

Arr(k,1)=Rng(i,1)

Ne*t

Ne*t

Range("D2").Resize(k,1).Value=Arr

EndSubSubtest()

Dimar

DimdAsObject

DimiAsInteger,jAsInteger

Setd=CreateObject("scripting.dictionary")

ar=Range("a1").CurrentRegion

Forj=1To3

Fori=2ToUBound(ar)

Ifar(i,j)<>""Then

d(ar(i,j))=""

EndIf

Ne*t

Ne*t

Range("d2:d65536").Clear

Range("d2").Resize(d.Count,1).NumberFormatLocal=""

Range("d2").Resize(d.Count,1)=Application.Transpose(d.keys)EndSubSubIterance()DimiAsLong

'定义循环变量i类型为长整型Fori=1To10'循环10次

IfApplication.CountIf(Range("A1:A10"),Cells(i,1))>1ThenCells(i,1).Font.Color=255

'从第一个单元格开场循环利用工作表函数Countif如果该单元格的值在A1:A10这个区域中的个数大于了1则就填充字体颜色为红色Ne*tEndSubSubIterance1()'录制一个条件格式

Range("A1:A10").FormatConditions.AddType:=*lE*pression,Formula1:=_

"=COUNTIF($A$1:$A$10,A1)>1"

Range("A1:A10").FormatConditions(1).Interior.Color=255EndSub最近在网上找到了一些比拟好的关于AdvancedFilter应用的例子，总结和分享如下：e*pression.AdvancedFilter(Action,

CriteriaRange,

CopyToRange,

Unique)e*pression

必需。该表达式返回“应用于〞列表中的对象之一。Action*lFilterAction

类型，必需。*lFilterAction可为以下*lFilterAction常量之一。*lFilterCopy*lFilterInPlaceCriteriaRangeVariant类型，可选。条件区域。如果省略本参数，则没有条件限制。CopyToRangeVariant类型，可选。如果Action为*lFilterCopy，则本参数指定被复制行的目标区域。否则忽略本参数。UniqueVariant类型，可选。如果为True，则重复出现的记录仅保存一条；如果为False，则筛选出所有符合条件的记录。默认值为False。例子：〔看〕SubMacro1()

Range("A1:D12").Select

Range("A1:D12").AdvancedFilterAction:=*lFilterCopy,CriteriaRange:=Range(_

"F5:I6"),CopyToRange:=Range("K1"),Unique:=FalseEndSub总结：在条件设定中：1.同一行的各条件是“and〞的关系2.不同行间是“or〞的关系3.条件列标题要和原来表格的一致4.在VBA条件围时要注意，在选定多行围时，空单元格也是一个条件，如本例，如果只选定“F5：I6〞，那只有“F6〞and＂Ｇ６＂的共同条件，但如果选“F5：I７〞，而第７行为空，则在以上条件下，还要考虑or""的条件(相当于全选)。Sub测试()DimrngAsRange,rngsAsRange,k%,a,bDimLastRowAAsInteger,LastRowBAsInteger'定义数据类型：设置对range单元格的引用，和定义K为整形变量，a,b为变体变量。LastRowA=[A65536].End(*lUp).Row'从A列最后一行向上找，找到有数据的行为止LastRowB=[B65536].End(*lUp).RowForEachrngIn["A2:A"&LastRowA]'外循环的围a=rng.ValueForEachrngsIn["B2:B"&LastRowB]'foreach循环的围b=rngs.ValueIfrng=rngsThenGoTo100'跳出外循环EndIfNe*trngsk=k+1Cells(k+1,"c")=rng'把没等的容复制到新的一列中100:Ne*trngEndSub正确的：Sub找出未有项()DimrngAsRange,rngsAsRange,lastcellBAsRange,lastcellAAsRange,k%,a,b'定义数据类型：设置对range单元格的引用，和定义K为整形变量，a,b为变体变量。SetlastcellA=Cells(Rows.Count,"a").End(*lUp)'查找最后A列最后一个非空单元格SetlastcellB=Cells(Rows.Count,"b").End(*lUp)'查找最后B列最后一个非空单元格ForEachrngInRange([A2],lastcellA)a=rng.ValueForEachrngsInRange([B2],lastcellB)b=rngs.ValueIfrng=rngsThenGoTo100EndIfNe*trngsk=k+1Cells(k+1,"d")=rng100:Ne*trngEndSub去除容：Sub去除填写容()Sheets("Sheet1").SelectRange("A2:A65536,B2:B65536,D2:D65536").SelectSelection.ClearContentsRange("A2").SelectEndSub找出重复的：Sub找出重复项()DimlastcellAAsRange,s1%,iSetlastcellA=Cells(Rows.Count,"a").End(*lUp)'查找最后A列最后一个非空单元格Range([A2]