EXCEL VBA 宏制作， 分组排序取值， 并生成多个目标表

578898187

现在我有个表，需要按照customer support (客户支持）生产多个目标表：目标表里的数据是每个customer support 前三名的customer 所有信息（按照销量sales排序的前三名）



也就是希望用VBA 实现按customer support 分组， 然后按sales 排序， 取出前三名，在生成多个目标表。
第一次发帖，希望有机会和大家讨论， 得到帮助。
非常感谢。

一把小刀闯天下

'自己修改

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, n
  arr = [a1].CurrentRegion.Offset(1)
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)
  Call dsort(arr, 1, UBound(arr, 1) - 1, 6, False) '降序
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 6) <> arr(j + 1, 6) Then
        If j > i Then Call dsort(arr, i, j, 4, False) '降序
        n = 1
        For k = 1 To UBound(arr, 2): brr(i, k) = arr(i, k): Next
        brr(i, k) = n
        For k = i + 1 To j
          If arr(k, 4) <> arr(k - 1, 4) Then n = n + 1 '可能有并列名次
          For kk = 1 To UBound(arr, 2): brr(k, kk) = arr(k, kk): Next
          brr(k, kk) = n
        Next
        i = j: Exit For
      End If
  Next j, i
'  Call dsort(brr, 1, UBound(brr, 1) - 1, 1, true)'Sort for Row ID
  [h2].Resize(UBound(brr, 1) - 1, UBound(brr, 2)) = brr
End Sub

Function dsort(arr, first, last, key, order)
  Dim i, j, k, t
  For i = first To last - 1
    For j = i + 1 To last
      If arr(i, key) < arr(j, key) Xor order Then
        For k = 1 To UBound(arr, 2)
          t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
        Next
      End If
  Next j, i
End Function

yxbaju

不生成表的不知道有没有SQL语句可以一下完成？有知道的留个言交流下

578898187

yxbaju 发表于 2018-10-5 20:05
不知道有没有SQL语句可以一下完成？有知道的留个言交流下
》》需要生成目标表的话修改下代码即可

SQL 用分析函数， partition by 和 rank 大概就可以做。
只是excel VBA 我完全没经验。

yxbaju

578898187 发表于 2018-10-5 20:39
SQL 用分析函数， partition by 和 rank 大概就可以做。
只是excel VBA 我完全没经验。

我现在的方案是遍历一个由cutomer support字段组成的字典，赋值给sql语句，然后循环执行该sql,将执行得出的结果顺延写入工作表，我再想是否有一个可以不需要遍历那个customer support创建的字典的方法

578898187

一把小刀闯天下 发表于 2018-10-5 19:16
'自己修改

Option Explicit

非常感谢， 我看到你的效果是把所有都排序了。
让我自己再研究下怎么完成接下来的步骤。