间隔 单元格排序问题（有附件）

qhxh1966

现有I1：W23  区域  每2列为一个单元 （I,J)(K,L)(m,n)...... 要求以I23，K23， M23。。。  排序  排序时一个单元整体移动（如M23移动时，N23一起移动    用VBA怎么写




见附件 工作表2为原文件   运行宏后达到 工作表1要求

Chip_Kenny

1. Sub zz()
   
2. Dim ar, a, b()
   
3. ar = Sheets(2).[i1].CurrentRegion.Value
   
4. ReDim b(1 To UBound(ar), 1 To UBound(ar, 2))
   
5. a = Array(7, 8, 1, 2, 5, 6, 3, 4, 11, 12, 9, 10, 13, 14)
   
6. For i = 1 To UBound(ar)
   
7.     For j = 1 To UBound(ar, 2)
   
8.         b(i, j) = ar(i, a(j - 1))
   
9.     Next
   
10. Next
    
11. With Sheets(1)
    
12.     .[i1].Resize(i - 1, j - 1).ClearContents
    
13.     .[i1].Resize(i - 1, j - 1) = b
    
14. End With
    
15. End Sub

复制代码

qhxh1966

Chip_Kenny 发表于 2018-9-27 12:48

谢谢    我要求只在工作表2中指定区域实现 怎么办

qhxh1966

Chip_Kenny 发表于 2018-9-27 12:48

这个  当区域外有数据时  也会把数据 带出如工作表2当I24有数值时  ，工作表1也会有     我要求只在工作表2该区域中重新排序

Chip_Kenny

更改為貢2吧。

1. Sub zz()
   
2. Dim ar, a, b()
   
3. ar = Sheets(2).[i1].CurrentRegion.Value
   
4. ReDim b(1 To UBound(ar), 1 To UBound(ar, 2))
   
5. a = Array(7, 8, 1, 2, 5, 6, 3, 4, 11, 12, 9, 10, 13, 14)
   
6. For i = 1 To UBound(ar)
   
7.     For j = 1 To UBound(ar, 2)
   
8.         b(i, j) = ar(i, a(j - 1))
   
9.     Next
   
10. Next
    
11. With [color=Red]Sheets(2)[/color]
    
12.     .[i1].Resize(i - 1, j - 1).ClearContents
    
13.     .[i1].Resize(i - 1, j - 1) = b
    
14. End With
    
15. End Sub

复制代码