求助，按某字段排序，但要分层进行，并子层要紧跟对应的层后显示

notoky · 发表于 2014-2-26 08:26

数据录入的次序是随机的，需要按产量分层显示，A。B。C。D是一级，此级按产量降序排，次序决定后，其紧跟后面的子公司级再排序，如B1.B2.B3，他们再按产量排序，紧跟在一级公司B的下一行,效果见最后那个表，

yjh_27 · 发表于 2014-2-26 21:19

参见附件。

notoky · 发表于 2014-2-27 22:10

谢谢，要的就这效果。不过还有个问题，公司的名称是中文的，子公司中并没有包含上级公司的名称，而且上级公司的名称字数也不固定，有没有解决方法？

yjh_27 · 发表于 2014-2-27 22:19

notoky 发表于 2014-2-27 22:10
谢谢，要的就这效果。不过还有个问题，公司的名称是中文的，子公司中并没有包含上级公司的名称，而且上级公 ...

你一定有组织结构对照表，对应编码即可。

notoky · 发表于 2014-2-27 22:28

另外这个函数的参数。第二个和第三个不太明白什么意思，有没有这方面的资料方便我学习下。谢谢了

yjh_27 · 发表于 2014-2-27 22:35

notoky 发表于 2014-2-27 22:28
另外这个函数的参数。第二个和第三个不太明白什么意思，有没有这方面的资料方便我学习下。谢谢了

Alt+F11 模块1 有说明。

或参见

多Key数组排序(分类、统计、重复处理)-自定义函数
http://club.excelhome.net/thread-1090007-1-1.html

notoky · 发表于 2014-2-28 09:37

我把部分公司的名称放到附件中了，我文中的第二个表算是组织结构对照表吗？另外谢谢你给的链接，我看了，不过我是新手，其中还有两参数不明白，YjhSort(A3:B13,"-1,Sl0;-1","2,1")中的Sl0;-1是对应参数解释的 SL;sl1;sl2这项嘛？=YjhSort(A3:B13,"Sla;1,-1","1u,2",,,,,,,G3:G6）中的"1u,2"是对应u;n嘛，我对其中的Sl0和1u是怎么理解的。谢谢了

yjh_27 · 发表于 2014-2-28 13:44

本帖最后由 yjh_27 于 2014-2-28 13:47 编辑

YjhSort(A3:B13,"-1,Sl0;-1","2,1")
参数2：
-1       降序，按数值排序
Sl0;-1 0 ：不排序，用于分组，本次不排序
         Sl：按照sl1（-1）固定长度（1位）进行排序
         -1 ：长度≠1的忽略

参数3：

=YjhSort(A3:B13,"Sla;1,-1","1u,2",,,,,,,G3:G6）中的"1u,2"是对应u;n嘛，我对其中的Sl0和1u是怎么理解的。谢谢了

参数3
1u 对参数1数组的1列按自定义序列排序，自定义序列默认首列

yjh_27 · 发表于 2014-2-28 20:19

notoky 发表于 2014-2-28 09:37
我把部分公司的名称放到附件中了，我文中的第二个表算是组织结构对照表吗？另外谢谢你给的链接，我看了，不 ...

组织结构对照表可参见附件：

yaozong · 发表于 2014-3-1 17:12

本帖最后由 yaozong 于 2014-3-1 17:15 编辑

程式:(附件中含3种方法)

Sub 排序_结果复盖原数据()''程式之一
Sheets("Sheet1").Activate
Dim arr, i, j, m, n, x, y
[a3:b13].Sort [b3], 2
arr = [a3:b13].Value
x = UBound(arr)
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
   If Len(arr(i, 1)) = 1 Then
      y = y + 1
      brr(y, 1) = arr(i, 1)
      brr(y, 2) = arr(i, 2)
   End If
Next
ReDim crr(1 To UBound(arr) + 1, 1 To 2)
For i = 1 To y
   crr(i + m, 1) = brr(i, 1)
   crr(i + m, 2) = brr(i, 2)
   For j = 1 To UBound(arr)
      If Len(arr(j, 1)) > 1 Then
         If Left(arr(j, 1), 1) = brr(i, 1) Then
            m = m + 1
            crr(i + m, 1) = arr(j, 1)
            crr(i + m, 2) = arr(j, 2)
         End If
      End If
   Next
Next
[a3].Resize(UBound(arr), 2) = crr
End Sub

		自动登录	找回密码
密码			免费注册