vba根据表1的列1数据顺序，对表二的数据排序

fang159

用vlookup表1和表2没有匹配项，试了很多公式也解决不了，不太懂VBA，恳请大神帮忙。

fang159

恳请大神帮忙

夏小乐

在表1添加一个辅助列填入序号，用vlookup将对应的序号引用到表2，然后在表2对序号进行排序就好了呀

Edugaoqi

根据表一排序.rar (17.08 KB, 下载次数: 17)

2019-8-5 08:55 上传

点击文件名下载附件

不知道你想在A列直接重排还是在右侧J列排，我就按得J列

fang159

Edugaoqi 发表于 2019-8-5 08:56
不知道你想在A列直接重排还是在右侧J列排，我就按得J列

你好，我是希望在表二的A直接重排的。
另外我想自己在表二增加列，可当我把代码里头的4改为5，增加新的代码时，却出现报错。能教教我怎么改动吗？

Edugaoqi

fang159 发表于 2019-8-5 09:52
你好，我是希望在表二的A直接重排的。
另外我想自己在表二增加列，可当我把代码里头的4改为5，增加新的 ...

arr = .Range("A1:D" & .Range("A65536").End(xlUp).Row)
改成 arr = .Range("A1:E" & .Range("A65536").End(xlUp).Row)
不然没有数组的第五列（E列），就没法赋值

要在A列重排 你加一句  
.UsedRange.Clear
然后最下面两行代码的 J 改成A

cui26896

根据表一排序.zip (15.74 KB, 下载次数: 29)

2019-8-5 10:34 上传

点击文件名下载附件

一把小刀闯天下

'数据量大考虑用字典，这里key数组非常小字典都可以不用

'如果无法找到匹配序列按原序排在最后

'另外你这示例结果为非稳定排序，，，

Option Explicit

Sub test()
  Dim arr, brr, i, j
  arr = Sheets("sheet2").[a1].CurrentRegion.Resize(, 5)
  brr = Sheets("sheet1").[a1].CurrentRegion.Resize(, 2)
  For i = 2 To UBound(brr, 1)
    brr(i, 2) = i
  Next
  For i = 2 To UBound(arr, 1)
    arr(i, 5) = UBound(brr, 1) + 1
    For j = 2 To UBound(brr, 1)
      If arr(i, 1) = brr(j, 1) Then arr(i, 5) = brr(j, 2): Exit For
    Next
  Next
  Call bsort(arr, 2, UBound(arr, 1), 1, UBound(arr, 2), 5)
  [j1].Resize(UBound(arr, 1), UBound(arr, 2) - 1) = arr
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) > arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
    Next
  Next
End Function

cui26896

二维数组多key稳定排序可以用香川老师的代码了，非常快，而且适应于大量数据。这种简单的实例用不牛刀。

fang159

谢谢各位大神，很感谢。问题解决了。