Question

EXCEL的VBA公式，求修改下

如图，这里想让表格排序，数据是3列一组，然后向下排序，当达到第44行的时候，就在第4列第二行排序过去，以此类推，然后一直向右走，然后以款式为主要条件排序，然后是编号
然后如果中间有删除任何一组，则后面的向前移上去

Answer 1

这个我还是建议现在其他工作表中全部进行排序，然后再用简单的公式导过去数据：

亲，望采纳哦！

追问

我也考虑了下，能不能这样，分sheet1跟sheet2，sheet1就用来写入，然后手动排序，然后设置一个按键，按下后让sheet1现有的数据按照上面的排序，排序到sheet2上去呢，这个应该能行得通

追答

这个写代码的话比较复杂啦，在sheet2中你只需要定义一下第二行的公式，然后向下拖拽，就完成了，不要太复杂哦！

Answer 2

试试这个

Sub 排序()
Application.ScreenUpdating = False
    With ActiveSheet
    
    Range("D2:F44").Cut
    .Paste Range("A45")
    
    Range("G2:I44").Cut
    .Paste Range("A88")
    
    Range("A2").Select

    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range("B2:B130"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("A2:A130"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       With ActiveSheet.Sort
        .SetRange Range("A1:I130")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
       End With
   
    Range("A88:C130").Cut
    .Paste Range("G2")
      
    Range("A45:C87").Cut
    .Paste Range("D2")
    End With
Application.ScreenUpdating = False
    
End Sub

追问

那这个的话，在I列走完之后，会向J列写过去吗？我这里数据基本都是要5-10页的

追答

不会，如果数据较多，且不定的话，得修改代码

追问

那能修改成走很多列的吗？我的想法是sheet1来写入跟排序，然后弄个按键，触发sheet2按照sheet1来排列，这样就简单多了，能行吗

追答

Sub 排序()
Application.ScreenUpdating = False
Rowws = 43 '根据实际修改
cols = 3  '根据实际修改
With ActiveSheet
coll = Range("IU2").End(1).Column / cols
For cn = 2 To coll
    Range(Cells(2, cn * cols - 2), Cells(1 + Rowws, cn * cols)).Cut
    .Paste Range("A" & 2 + (cn - 1) * Rowws)
Next cn
Range("A2").Select
 .Sort.SortFields.Clear
 .Sort.SortFields.Add Key:=Range("B2:B65536"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 .Sort.SortFields.Add Key:=Range("A2:A65536"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
    .SetRange Range(Cells(1, 1), Cells(65536, cols))
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
   End With
 For cn = 2 To coll
  Range(Cells(2 + (cn - 1) * Rowws, 1), Cells(1 + cn * Rowws, cols)).Cut
  .Paste Cells(2, cn * cols - 2)
 Next cn
 End With
Application.ScreenUpdating = True
End Sub

追问

然后呢？你这个只是排序，但是不会变成上面那样子排列

Answer 3

写程序要花较长的时间和精力，你的数据不是很多，你可以将数据复制粘贴到一系列，排序后再按你的44行要求 复制到你要求的位置。这样做更简单。

追问

我也考虑了下，能不能这样，分sheet1跟sheet2，sheet1就用来写入，然后手动排序，然后设置一个按键，按下后让sheet1现有的数据按照上面的排序，排序到sheet2上去呢，这个应该能行得通