[已解决]求助 数据按组数平分 怎么搞

sobili

这是你要的结果吗？希望对你有所帮助。 求助.zip (14.72 KB, 下载次数: 3)

2015-5-21 16:00 上传

点击文件名下载附件

爱疯

Sub test()
    Dim A, i
    A = Range("A1").CurrentRegion
    A = test38(1, UBound(A), Int(UBound(A) / 2))
    Range("a:b").Interior.ColorIndex = xlNone

    For i = 1 To UBound(A)
        Range(Cells(A(i), 1), Cells(A(i), 2)).Interior.ColorIndex = 4
    Next i
End Sub


Function test38(x, y, z)
    Dim arr(), brr(), i, t
    ReDim arr(x To y)    '数据源
    ReDim brr(1 To z)    '输出数组
    For i = x To y
        arr(i) = i
    Next

    For i = 1 To z
        t = Int(((y - x + 1) - (i - 1)) * Rnd) + (x + (i - 1))
        brr(i) = arr(t)
        arr(t) = arr(x + (i - 1))
    Next
   test38 = brr
End Function

求助3.rar (11.5 KB, 下载次数: 9)

2015-5-21 16:06 上传

点击文件名下载附件


说明：
1）有颜色的是一组，没颜色的是另一组。
2）如果行数是偶数，则取其一半。
     这里行数是奇数，就取了17行。

zks63566873

sobili 发表于 2015-5-21 15:59
这是你要的结果吗？希望对你有所帮助。
http://www.excelpx.com/forum.php?mod=attachment&aid=MzYxNjgyfDRhMDJiNTE5ZDY1MmU3YjQ5MWIzZTEzMmQxZjZhNmM5fDE3MTQ2NDQ2NTk%3D&request=yes&_f=.zip

您这个有点相似  输入分组数就可以分  但是好像怎么输分到的都是按顺序分的

zks63566873

爱疯 发表于 2015-5-21 16:09
Sub test()
    Dim A, i
    A = Range("A1").CurrentRegion

这个看到很好！！！！只是分完组  我不好分组打印！！！我的想法是分组后可以分成两列  一列一组列二组！！

爱疯

求助3.rar (11.5 KB, 下载次数: 19)

2015-5-21 16:55 上传

点击文件名下载附件

这样呢

zks63566873

爱疯 发表于 2015-5-21 16:55
这样呢

- -  有差别么 - -  感觉和之前那个一样啊

爱疯

zks63566873 发表于 2015-5-21 17:15
- -  有差别么 - -  感觉和之前那个一样啊

第1组，放到第2个工作表了
第2组，放到第3个工作表了

没发现？

zks63566873

爱疯 发表于 2015-5-21 17:17
第1组，放到第2个工作表了
第2组，放到第3个工作表了

= =  没发现  新手   谢谢大神！！！跪拜

zks63566873

爱疯 发表于 2015-5-21 17:17
第1组，放到第2个工作表了
第2组，放到第3个工作表了

= =  好像没有诶  第二工作表空白啊

爱疯

我改过了的，一定是我传错了，
为什么手快给删了，并清空了。。。。。。
算了，再写次。。。