AB表找出相同或者不同值并求和

107976422

A表有数据

B表数据


根据AB表对比找出不同点，但是加一个根据身份证求和不懂了，求高手指点一下

107976422

B表一键清除：希望能一键清除B-C-D 表内2横开始的数据

liulang0808

楼主的需求，看了一下，不大明白，建议结合附件举例描述下吧

107976422

liulang0808 发表于 2020-1-14 12:11
楼主的需求，看了一下，不大明白，建议结合附件举例描述下吧

前面好像上传过附件了。现在传一份，您帮我看看，谢谢

107976422

大佬们都去哪里了

一把小刀闯天下

'看不太懂。就是根据已有或未有分别对相同人员工资等汇总的吧

'一楼附件，，，

Option Explicit

Sub test()
  Dim arr, brr, crr, i, j, dic(2), m1, m2
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  arr = Sheets("系统已有人员名单").[a1].CurrentRegion
  For i = 2 To UBound(arr, 1)
    dic(0)(arr(i, 2)) = 1
  Next
  arr = Sheets("本月人员名单").[a1].CurrentRegion.Resize(, 5)
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
  crr = brr
  For i = 2 To UBound(arr, 1)
    If dic(0).exists(arr(i, 2)) Then
      If dic(1).exists(arr(i, 2)) Then
        For j = 3 To UBound(arr, 2)
          brr(dic(1)(arr(i, 2)), j) = brr(dic(1)(arr(i, 2)), j) + arr(i, j)
        Next
      Else
        m1 = m1 + 1: dic(1)(arr(i, 2)) = m1
        For j = 1 To UBound(arr, 2)
          brr(m1, j) = arr(i, j)
        Next
      End If
    Else
      If dic(2).exists(arr(i, 2)) Then
        For j = 3 To UBound(arr, 2)
          crr(dic(2)(arr(i, 2)), j) = crr(dic(2)(arr(i, 2)), j) + arr(i, j)
        Next
      Else
        m2 = m2 + 1: dic(2)(arr(i, 2)) = m2
        For j = 1 To UBound(arr, 2)
          crr(m2, j) = arr(i, j)
        Next
      End If
    End If
  Next
  With Sheets("系统已有人员")
    .[b:b].NumberFormatLocal = "@"
    .[a2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
  End With
  With Sheets("系统未有人员")
    .[b:b].NumberFormatLocal = "@"
    .[a2].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
  End With
End Sub

107976422

一把小刀闯天下 发表于 2020-1-14 22:40
'看不太懂。就是根据已有或未有分别对相同人员工资等汇总的吧

'一楼附件，，，

对的，就是这样。太感谢了。

13583313392

一把小刀闯天下 发表于 2020-1-14 22:40
'看不太懂。就是根据已有或未有分别对相同人员工资等汇总的吧

'一楼附件，，，

能不能讲解一下中间的各层循环啊，看了半天没看明白