用VBA代碼實現匯總去重

試試下面的代碼，問題有人問過：

Sub?stet()

On?Error?Resume?Next

Dim?sh?As?Worksheet

Dim?col?As?New?Collection

Dim?rng?As?Range,?irng?As?Range

Dim?arr(),?brr(),?i&,?x&

For?Each?sh?In?Worksheets

If?sh.Name?<>?"Sheet4"?Then

For?Each?rng?In?sh.Range("a4",?sh.Cells(Rows.Count,?1).End(3))

col.Add?rng,?CStr(rng)

Next

ReDim?Preserve?arr(1?To?32,?1?To?col.Count)

For?i?=?1?To?col.Count

For?x?=?2?To?32

Set?irng?=?sh.[a:a].Find(col(i),?,?,?1)

If?Not?irng?Is?Nothing?Then

arr(1,?i)?=?col(i)

If?arr(x,?i)?=?0?Then?arr(x,?i)?=?IIf(sh.Cells(irng.Row,?x)?=?"√",?1,?"0")

End?If

Next

Next

End?If

Next

On?Error?GoTo?0

ReDim?brr(1?To?col.Count,?1?To?2)

For?i?=?1?To?UBound(arr,?2)

For?x?=?2?To?UBound(arr)

brr(i,?1)?=?arr(1,?i)

brr(i,?2)?=?arr(x,?i)?+?brr(i,?2)

Next

Next

Range("a3").Resize(UBound(brr),?2)?=?brr

End?Sub