[已解决]一个较复杂的数据分组，不知道如何写程序，求高手出招，谢谢！

coolzyman

一个较复杂的数据分组，不知道如何写程序，求高手出招，谢谢！

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-3-27 12:41

改动数字后再按一下按钮吧，change事件虽然可以解决，但是没看到你的最终表，
担心你套用时会出现问题。

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, brr, n&, m&
   
3. n = [e1]: m = 1
   
4. arr = [a3].CurrentRegion
   
5. brr = [d3].Resize(UBound(arr) * 3 - 1, n)
   
6. [d4].Resize(65533, 253).ClearContents
   
7. For j = 1 To UBound(brr, 2)
   
8.   For i = 1 To brr(1, j)
   
9.     m = m + 1
   
10.     brr(i * 3 - 1, j) = arr(m, 1)
    
11.     brr(i * 3, j) = arr(m, 2)
    
12.   Next i
    
13. Next j
    
14. [d3].Resize(UBound(brr), UBound(brr, 2)) = brr
    
15. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

改动数字后再按一下按钮吧，change事件虽然可以解决，但是没看到你的最终表，
担心你套用时会出现问题。

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, brr, n&, m&
   
3. n = [e1]: m = 1
   
4. arr = [a3].CurrentRegion
   
5. brr = [d3].Resize(UBound(arr) * 3 - 1, n)
   
6. [d4].Resize(65533, 253).ClearContents
   
7. For j = 1 To UBound(brr, 2)
   
8.   For i = 1 To brr(1, j)
   
9.     m = m + 1
   
10.     brr(i * 3 - 1, j) = arr(m, 1)
    
11.     brr(i * 3, j) = arr(m, 2)
    
12.   Next i
    
13. Next j
    
14. [d3].Resize(UBound(brr), UBound(brr, 2)) = brr
    
15. End Sub

复制代码

coolzyman

非常感谢“大灰狼1976 ”的解答，完美的解决了我的这个难题！高手！