如何让列2按列1顺序排列 且后面各列顺序一致

lnlz

列1	列2	成绩		列2	成绩
张三	刘一	34		张三	46
李四	李四	45		李四	45		定义了两个名称
王二	马六	6		王二	44		lie2和xulie
麻子	王二	44		麻子	34
	张三	46		刘一	34
	赵六	4		马六	6
	麻子	34		赵六	4
	何炅	43		何炅	43

效果如图 群里之前大佬做过一个 但是行数一多就不好用了 有几千条数据要处理

lnlz

之前别人做的 行数一多就出问题了

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, dic, cnt, m, brr, temp
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)
  For i = 1 To UBound(arr, 1): dic(arr(i, 1)) = i: Next
  arr = Range("b2:c" & Cells(Rows.Count, "b").End(xlUp).Row)
  brr = arr: temp = brr
  For i = 1 To UBound(arr, 1)
    If dic.exists(arr(i, 1)) Then
      cnt = cnt + 1
      For j = 1 To UBound(arr, 2): brr(cnt, j) = arr(i, j): Next
    End If
  Next
  m = cnt
  For i = 1 To UBound(arr, 1)
    If Not dic.exists(arr(i, 1)) Then
      m = m + 1
      For j = 1 To UBound(arr, 2): brr(m, j) = arr(i, j): Next
    End If
  Next
  Call msort(brr, temp, 1, cnt, 1, UBound(arr, 2), 1, dic)
  [e2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
End Sub

Function msort(arr, temp, first, last, left, right, key, dic)
  Dim i, j, k, kk, mid
  If first <> last Then
    mid = Int((first + last) / 2)
    msort arr, temp, first, mid, left, right, key, dic
    msort arr, temp, mid + 1, last, left, right, key, dic
    i = first: j = mid + 1: k = first
    While i <= mid And j <= last
      If dic(arr(i, key)) <= dic(arr(j, key)) Then
        For kk = left To right: temp(k, kk) = arr(i, kk): Next
        k = k + 1: i = i + 1
      Else
        For kk = left To right: temp(k, kk) = arr(j, kk): Next
        k = k + 1: j = j + 1
      End If
    Wend
    While i <= mid
      For kk = left To right: temp(k, kk) = arr(i, kk): Next
      k = k + 1: i = i + 1
    Wend
    While j <= last
      For kk = left To right: temp(k, kk) = arr(j, kk): Next
      k = k + 1: j = j + 1
    Wend
    For i = first To last
      For j = left To right
        arr(i, j) = temp(i, j)
    Next j, i
  End If
End Function

lnlz

一把小刀闯天下 发表于 2018-9-28 19:55
Option Explicit

Sub test()

大神太牛了 之前找的公式不是没用就是运算卡死 话说如果列1的数据在列2里找不到的话能自动空行就更好了  就是保证A列和E列一一对齐 A列数据在B列查找不到 对应的EF列就留空 大神看看有空能否解决下 没空也无所谓 已经帮了大忙了 实在是非常感谢