試試下面的代碼,問題有人問過:
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"?ThenFor?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)?=?brrEnd?Sub