利用VBA尋找重復(fù)選項(xiàng)

-.z.一、函數(shù)1、將公式=IF(ISERROR(VLOOKUP(B2,B$1:B1,1,0)),"","重復(fù)")在數(shù)據(jù)區(qū)域后空白列第二行，光標(biāo)對準(zhǔn)右下角成“+〞狀時將公式拖〔或雙擊〕下去，效果如圖：2、=COUNTIF(A:A,A1)，大于1的重復(fù)。二、VBA找出一列或一行中沒有的重新列出來，用全部的去循環(huán)比照需要排除的。Sub測試()DimrngAsRange,rngsAsRange,k%,a,b定義數(shù)據(jù)類型：設(shè)置對range單元格的引用，和定義K為整形變量，a,b為變體變量。ForEachrngIn[a2:a6]foreach外循環(huán)的圍a=rng.ValueForEachrngsIn[b2:b4]foreach循環(huán)的圍b=rngs.ValueIfrng=rngsThenGoTo100跳出外循環(huán)EndIfNe*trngsk=k+1Cells(k+1,"c")=rng把沒等的容復(fù)制到新的一列中100:Ne*trngEndSub找出重復(fù)的并列出次數(shù)：Sub統(tǒng)計(jì)()

y1=1'開場列為A列〔在E*CEL中，A列的列號為1〕y2=4'完畢列為D列〔在E*CEL中，D列的列號為4〕*=2

n1=255'輔助列n2=y2+2'結(jié)果顯示列，結(jié)果顯示在源數(shù)據(jù)列的右側(cè)，中間間隔一列。Fori=y1Toy2

s=Cells(65536,y1).End(*lUp).Row'各列數(shù)據(jù)的數(shù)量Range(Cells(1,i),Cells(s,i)).CopyCells(*,n1)'把所有數(shù)據(jù)復(fù)制到輔助列中*=*+s

Ne*t

Cells(1,n1)="數(shù)據(jù)":Cells(1,n2+1)="次數(shù)"

'使用“高級篩選〞功能將不重復(fù)數(shù)據(jù)顯示在“結(jié)果顯示列〞中Columns(n1).AdvancedFilter2,,Cells(1,n2),1

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

'下面代碼用COUNTIF函數(shù)統(tǒng)計(jì)重復(fù)次數(shù)Fori=2Tos1

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

Ne*t

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

EndSubSub按指定次數(shù)重復(fù)數(shù)據(jù)()

DimRng,Arr()

DimiAsInteger,jAsInteger,k

AsInteger

DimLastRowAsInteger,TotalAsInteger

LastRow=[A65536].End(*lUp).Row'從A列最后一行向上找，找到有數(shù)據(jù)的行為止

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

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

ReDimArr(1ToTotal,1To1)'重新定義數(shù)組ARR,調(diào)整第一維下標(biāo)從1起到20止,第二維下標(biāo)從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

'定義循環(huán)變量i類型為長整型Fori=1To10'循環(huán)10次

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

'從第一個單元格開場循環(huán)利用工作表函數(shù)Countif如果該單元格的值在A1:A10這個區(qū)域中的個數(shù)大于了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最近在網(wǎng)上找到了一些比擬好的關(guān)于AdvancedFilter應(yīng)用的例子，總結(jié)和分享如下：e*pression.AdvancedFilter(Action,

CriteriaRange,

CopyToRange,

Unique)e*pression

必需。該表達(dá)式返回“應(yīng)用于〞列表中的對象之一。Action*lFilterAction

類型，必需。*lFilterAction可為以下*lFilterAction常量之一。*lFilterCopy*lFilterInPlaceCriteriaRangeVariant類型，可選。條件區(qū)域。如果省略本參數(shù)，則沒有條件限制。CopyToRangeVariant類型，可選。如果Action為*lFilterCopy，則本參數(shù)指定被復(fù)制行的目標(biāo)區(qū)域。否則忽略本參數(shù)。UniqueVariant類型，可選。如果為True，則重復(fù)出現(xiàn)的記錄僅保存一條；如果為False，則篩選出所有符合條件的記錄。默認(rèn)值為False。例子：〔看〕SubMacro1()

Range("A1:D12").Select

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

"F5:I6"),CopyToRange:=Range("K1"),Unique:=FalseEndSub總結(jié)：在條件設(shè)定中：1.同一行的各條件是“and〞的關(guān)系2.不同行間是“or〞的關(guān)系3.條件列標(biāo)題要和原來表格的一致4.在VBA條件圍時要注意，在選定多行圍時，空單元格也是一個條件，如本例，如果只選定“F5：I6〞，那只有“F6〞and＂Ｇ６＂的共同條件，但如果選“F5：I７〞，而第７行為空，則在以上條件下，還要考慮or""的條件(相當(dāng)于全選)。Sub測試()DimrngAsRange,rngsAsRange,k%,a,bDimLastRowAAsInteger,LastRowBAsInteger'定義數(shù)據(jù)類型：設(shè)置對range單元格的引用，和定義K為整形變量，a,b為變體變量。LastRowA=[A65536].End(*lUp).Row'從A列最后一行向上找，找到有數(shù)據(jù)的行為止LastRowB=[B65536].End(*lUp).RowForEachrngIn["A2:A"&LastRowA]'外循環(huán)的圍a=rng.ValueForEachrngsIn["B2:B"&LastRowB]'foreach循環(huán)的圍b=rngs.ValueIfrng=rngsThenGoTo100'跳出外循環(huán)EndIfNe*trngsk=k+1Cells(k+1,"c")=rng'把沒等的容復(fù)制到新的一列中100:Ne*trngEndSub正確的：Sub找出未有項(xiàng)()DimrngAsRange,rngsAsRange,lastcellBAsRange,lastcellAAsRange,k%,a,b'定義數(shù)據(jù)類型：設(shè)置對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找出重復(fù)的：Sub找出重復(fù)項(xiàng)()DimlastcellAAsRange,s1%,iSetlastcellA=Cells(Rows.Count,"a").End(*lUp)'查找最后A列最后一個非空單元格Range([A2]