|
发表于 2014-3-29 15:52
|
显示全部楼层
本楼为最佳答案
本帖最后由 dsmch 于 2014-3-29 15:54 编辑
- Sub Macro1()
- Dim arr, brr(1 To 1, 1 To 7), k%, s%, s2%, j%, i&
- For i = 3 To Range("e65536").End(xlUp).Row Step 13
- arr = Cells(i + 1, 5).Resize(12, 7)
- For k = 1 To UBound(arr, 2)
- s = 0: s2 = 0
- For j = 1 To UBound(arr)
- If arr(j, k) Mod 2 = 0 Then s = s + 1 Else s2 = s2 + 1
- Next
- If s = UBound(arr) Then brr(1, k) = "双"
- If s2 = UBound(arr) Then brr(1, k) = "单"
- Next
- Cells(i, 5).Resize(1, UBound(brr, 2)) = brr
- Erase brr
- Next
- End Sub
复制代码 |
|