excel函数或vba如何把一组数据分割n组中n组的数据？高分求助！

Question

如题，看下图，把一组原始数据（两位数值，最多100个数值）组按照要求平均分割成比如“8”个数据组（并不一定绝对平均，会有少许差异存在），并且要求原始数据中的任何一个数值在比如“7”个数据组中存在。要求分割组数和中出组数都可以被自定义，即n组中n组，最多可设定10组。请用函数或vba完成，在线等了。。。请参考下面的举例图 如需下图的举例excel表格请告知，高分求助 先在这里感谢各位大神的帮助了！

Answer 1

Sub test() Dim InCell As String '输入的单元格 Dim InElementNumber As Integer '需要重新定义每行的个数 Dim Aims_Arr() As String '存放分组后数据的数组 Dim RowNumber As Integer '原始数据个数 Dim GroupNumber As Integer '原始数据根据重新定义的个数能分几组 Dim InColumn As String '输入单元格所在的列 InCell = InputBox("请输入数据所在列的某个单元格，样式如【A1】") InElementNumber = InputBox("请输入每行按多少个数字排列") RowNumber = Range(InCell).CurrentRegion.Rows.Count InColumn = Left(InCell, 1) GroupNumber = Application.Ceiling(RowNumber / InElementNumber, 1) ReDim Aims_Arr(1 To GroupNumber) b = 1'a是记数组中每个元素拼接多少值'b是记录下一次循环从哪个地方开始 For t = 1 To GroupNumber Aims_Arr(t) = "" a = 1 For i = b To RowNumber If a <> InElementNumber + 1 Then Aims_Arr(t) = Aims_Arr(t) & Range(InColumn & i).Value a = a + 1 b = b + 1 Else Exit For End If Next Next For t = 1 To GroupNumber Range("B" & t) = Aims_Arr(t) Next End Sub追问

不对哦，这位大侠，我看到你所列出的一模一样的vba是解决另外一个问题的，和我这个不搭嘎哦。。。不管怎样 先谢谢你的热心了，我继续找其他朋友帮忙吧。。。

Answer 2

设原始数据x个(100以内)，分成m(小于10)组，任一原始数要在n组中重复出现。
即数据总数有xn，组有xn/m(向上取整)个原始数据。
各组中数据有没有限制和要求？仅要求重复出现次数一定和各组成员个数接近？？追问

你好，谢谢帮忙，各组数据没什么限制，成员个数均分相近即可 有时不一样也没关系，因为不可能全部一样，每组里不要有重复的数据，且能够自动间隔自定义时间进行分割数据就可以了。。。

Answer 3

m InElementNumber As Integer '需要重新定义每行的个数 Dim Aims_Arr() As String '存放分组后数据的数组 Dim RowNumber As Integer '原始数据个数 Dim GroupNumber As Integ

Answer 4

你把数据表发给我，私信联系。追问

已经私信了，先谢谢这位大神了！！！

追答

因为不了解其它的要求与限制条件：试试下面这个代码是否满足你的要求？

Sub SsK()
Dim M As Integer   '一共分成M组，M<=10
Dim N As Integer   '每个数据出现在N个组里，N<=M
Dim d() As String
Dim SZ() As String
Dim LinStr As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

'这里手动给M,N赋值
M = 8
N = 7

With Excel.Application.ActiveWorkbook.Sheets("待测试结果")
   '获得原始数据
   LinStr = .Range("J12").Value
   '把数据拆分保存到数组里
   d = Split(LinStr, " ")
   
   '根据要求分布配置
   ReDim SZ(M) As String
   For i = 1 To M
      SZ(M) = ""
   Next i
   k = 0
   For i = 0 To UBound(d)
      For j = 1 To N
         k = k + 1
         If k > M Then k = k - M
         SZ(k) = SZ(k) & d(i) & " "
      Next j
   Next i

   '显示到指定位置
   For i = 1 To M
      .Range("K" & CStr(i + 13)).Value = SZ(i)
   Next i
End With
End Sub

追问

大神 太感谢了，就是这个意思哦！！！这里我还有一个小小的问题，就是如果在您的vba上加上一个时间量的自动执行可以吗？比如设定每间隔10秒（自定义间隔时间）运行一次这个分割动作 如果可以 麻烦大神帮我改一下内容，一旦成功立即采纳！！！谢谢了
还有一个小疑问，就是显示到指定位置是否可以由k列一直往下显示，改为在比如k14单元格开始的这一行连续显示，也就是树列改为横列的意思，当然如果麻烦就算了哈。。。

追答

间隔一段时间自动执行，那得用VB编写程序来实现比较好了！
关于在一行里显示，这个稍微改变就可以实现的，但是你的说具体一点，k14这里是一直到AB14合并单元格的，那么接下来是要放到AC14开始了？？？

追问

大神 您好，关于一行里显示，我可能没有说清楚，是指把要显示的数据从一列10行显示，改为一行10列显示， 就是从k14开始可以不要合并格，每一个单元格显示10组数据中的一组即可(k14/l14/m14/n14...)一直到10组数据，显示到一行中。。。

追答

首先你自己把单元格的合并设置去除，那只要把最后那个显示部分改为：
'显示到指定位置
For i = 1 To M
.Cells(14, i + 10).Value = SZ(i)
Next i

追问

好的 ，大神，那间隔一段时间自动执行分割呢？比如每隔10秒一次 自定义。。。

追答

要每间隔10秒钟自动执行一次，方法如下：

打开EXCEL文件，按ALT+F11，进入VBA代码编辑窗口，使用菜单[插入]--[模块]，完成插入一个模块，见下图；

在模块窗口里编写代码，如下：

代码如下：

Public Sub SsK()
Dim M As Integer   '一共分成M组，M<=10
Dim N As Integer   '每个数据出现在N个组里，N<=M
Dim d() As String
Dim SZ() As String
Dim LinStr As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

'这里手动给M,N赋值
M = 8
N = 7

With Excel.Application.ActiveWorkbook.Sheets("待测试结果")
   '获得原始数据
   LinStr = .Range("J12").Value
   '把数据拆分保存到数组里
   d = Split(LinStr, " ")
   
   '根据要求分布配置
   ReDim SZ(M) As String
   For i = 1 To M
      SZ(M) = ""
   Next i
   k = 0
   For i = 0 To UBound(d)
      For j = 1 To N
         k = k + 1
         If k > M Then k = k - M
         SZ(k) = SZ(k) & d(i) & " "
      Next j
   Next i

   '显示到指定位置
   For i = 1 To M
      .Range("K" & CStr(i + 13)).Value = SZ(i)
   Next i
End With

   Call MyPro
End Sub

Public Sub MyPro()
   Excel.Application.OnTime Now() + TimeValue("00:00:10"), "SSk"
End Sub



本回答被提问者采纳