悬赏求助（四）最佳答案奖金200元（奖金已发放，谢谢参与）

wyan1086

问题：将FW列的数据，按照A-O共14列数据的升序分别重新排列，得到14组新排列数据，将这14组数据在GK列中不间断依次排列出来。再将FX列数据根据
Q-AE列数据用同样方式重新排列并在GL列中列出，依次类推。共有11组数据，每组14种排列方式。要求用宏键方式表达并开放算法。

参考：我们第二期悬赏求助曾经提过类似问题（http://club.excelhome.net/thread-1395301-1-1.html），是一组数据的14种排列顺序，已经成功解决，这次只是同时完成了11组数据，没有其他变化。问题相对比较简单，性价比颇高，望大家多多参与多多支持，万分感谢。

我们将选择最优答案给予奖金奖励，奖金200元，将在有答案当天发放。往期奖金都是100，过年期间给大家多送点福利，祝大家新年快乐！

关于奖金：因为我们都是文科生，没有人懂excel，故而不是抱着学习的心态，而是完全拿来主义，讲求实用，所以实在不好意思白白使用大家的时间来解决问题，这才每次提问都会有不低于100元旦奖金作为酬谢。并非是对各位大神们用金钱亵渎，而是感觉除了用奖金的形式，没有其它更好的方式表达我们求教的诚意。往期三次问题都圆满解决，奖金也都如数兑现，以后还会有各种问题要求教，希望论坛里各位大神多多帮助，万分感谢！

wyan1086

不知道对问题的表述是否清晰明了，如果不太清楚的可以看我们第二期问题的连接http://club.excelhome.net/thread-1395301-1-1.html
，或者留言沟通。感谢大家！

活在理想的世界

111111111111111111111111111111111111111111111111111111111111111

准提部林

1. Sub TEST()
   
2. Dim R, xA As Range, xB As Range, xH As Range, xE As Range, i&, j%
   
3. Application.ScreenUpdating = False
   
4. R = Cells(Rows.Count, 1).End(xlUp).Row
   
5. Set xA = [A1]: Set xB = [FW1]: Set xH = [GK1]: Set xE = xH
   
6. For i = 1 To 11
   
7. For j = 1 To 16
   
8. 　　If xA <> "" Then
   
9. 　　　xA.Resize(R).Copy xE(1, 2)
   
10. 　　　xB.Resize(R).Copy xE
    
11. 　　　xE.Resize(R, 2).Sort Key1:=xE(1, 2), Order1:=xlAscending, Header:=xlNo
    
12. 　　　Set xE = xE(R + 1)
    
13. 　　End If
    
14. 　　Set xA = xA(1, 2)
    
15. Next j
    
16. Set xH = xH(1, 2): Set xE = xH: Set xB = xB(1, 2)
    
17. Next i
    
18. [GV:GV].Clear
    
19. End Sub

复制代码

　
Xl0000319.rar (46.54 KB, 下载次数: 6)

2018-2-17 11:21 上传

点击文件名下载附件

　
　

wondernut

牛！我就蹭个热闹。。这图给人的感觉就像彩票似的。。。哈哈

wyan1086

活在理想的世界 发表于 2018-2-17 11:07
111111111111111111111111111111111111111111111111111111111111111

感谢参与，奖金已转到支付宝账户，请查收

活在理想的世界

wyan1086 发表于 2018-2-17 17:36
感谢参与，奖金已转到支付宝账户，请查收

谢谢。。。。。。。。。

l1g1p

我也来学习一下！！