两张表比对，分别提取性名列不重复值所在的整行到新表中

mercy1218

要求：
      02表中存在，01表中不存在的人（姓名列为准），整行提取到增员表中
      01表中存在，02表中不存在的人（姓名列为准），整行提取到减员表中
      如果部门列为退休或者调离，则该行不参与计算。
如果列数很少，我大概知道如何用字典提取，但如果列数很多怎么办，比如可能会有200多列，所以要整行提取。

wdx223

直接用高级筛选，或者用最新的filter函数可以实现

mercy1218

wdx223 发表于 2019-9-17 12:26
直接用高级筛选，或者用最新的filter函数可以实现

就是不想用筛选，想用VBA或者SQL解决才在这个版块问啊。
SQL倒是照猫画虎做了一个能成功，但很慢，想看看字典数组有没有办法解决。

一把小刀闯天下

'如果姓名有重复结果就变得不确定，最好用ID等唯一值来作为字典键，，，

Option Explicit

Sub test()
  Dim arr(2), i, j, m, mark
  mark = "调离、退休"
  ReDim dic(UBound(arr))
  For i = 1 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
    arr(i) = Sheets(Format(i, "00")).[a1].CurrentRegion
    For j = 2 To UBound(arr(i))
      If InStr(mark, arr(i)(j, 2)) = 0 Then dic(i)(arr(i)(j, 3)) = i
    Next
  Next
  For i = 2 To UBound(arr(1))
    If Not dic(2).exists(arr(1)(i, 3)) And InStr(mark, arr(1)(i, 2)) = 0 Then
      m = m + 1
      For j = 1 To UBound(arr(1), 2)
        arr(1)(m, j) = arr(1)(i, j)
      Next
    End If
    With Sheets("减员").[a2]
      .Resize(Rows.Count - 1, UBound(arr(1), 2)).ClearContents
      If m > 0 Then .Resize(m, UBound(arr(1), 2)) = arr(1)
    End With
  Next
  m = 0
  For i = 2 To UBound(arr(2))
    If Not dic(1).exists(arr(2)(i, 3)) And InStr(mark, arr(2)(i, 2)) = 0 Then
      m = m + 1
      For j = 1 To UBound(arr(2), 2)
        arr(2)(m, j) = arr(2)(i, j)
      Next
    End If
    With Sheets("增员").[a2]
      .Resize(Rows.Count - 1, UBound(arr(2), 2)).ClearContents
      If m > 0 Then .Resize(m, UBound(arr(2), 2)) = arr(2)
    End With
  Next
End Sub

wdx223

字典可以这样解决

wdx223

感觉ADO也不是太慢

mercy1218

wdx223 发表于 2019-9-17 13:10
感觉ADO也不是太慢

因为实际的表有100多列上千行，还有些别的限制因素。
感谢帮助，回头我先试试。

月关

wdx223 发表于 2019-9-17 13:10
感觉ADO也不是太慢

请问老师，这个如果用外连接或者内连接（可以吗？）应该怎样写？
您这种可以写出来，然后想用外连接试试速度，总是不成功…………
Sql = "select a.* from (select * from [02$] where 部门<>'退休' and 部门<>'调离')a left join (select * from [01$] where 部门<>'退休' and 部门<>'调离')b on a.姓名<>b.姓名"

结果查出来一大坨……

月关

用 inner join 也不行，但是感觉用这个应该是更好些

月关

我好像会了，哈哈


一塌糊涂！还请老师们指教