|
发表于 2014-12-4 15:54
|
显示全部楼层
本楼为最佳答案
代码已修正,请测试- Sub Macro1()
- Dim arr, d, m%, n%, i&, j%, k%
- Set d = CreateObject("scripting.dictionary")
- For m = 1 To 3
- For n = 1 To 4
- arr = Sheets(n).Range(Sheets(n).Cells(m + 3, "n"), Sheets(n).Cells(m + 3, "de"))
- For i = 1 To UBound(arr)
- For j = 1 To UBound(arr, 2)
- d(arr(i, j)) = d(arr(i, j)) + 1
- Next
- Next
- Next
- a = d.keys: b = d.items
- For k = 0 To d.Count - 1
- If b(k) = Application.Max(d.items) Then Sheet1.Cells(8, m + 8) = a(k): Exit For
- Next
- d.RemoveAll
- Next
- End Sub
复制代码 |
|