|
- Sub 比对()
- Dim Sh As Worksheet
- arr = Sheets("人员").[a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- ReDim brr(1 To UBound(arr), 1 To 3)
- brr(1, 1) = "人员"
- For i = 2 To UBound(arr) '要比对的人员
- brr(i, 1) = arr(i, 1)
- d(arr(i, 1)) = i
- Next
- For k = 1 To 2 '分表比对
- Set Sh = Worksheets(k)
- brr(1, k + 1) = Sh.Name
- crr = Sh.[a1].CurrentRegion
- For kk = 2 To UBound(crr)
- p = d(crr(kk, 3))
- If p > 0 Then '分表人员需比对的
- If Len(brr(p, k + 1)) = 0 Then
- brr(p, k + 1) = crr(kk, 4)
- ElseIf InStr(brr(p, k + 1), crr(kk, 4)) = 0 Then
- brr(p, k + 1) = brr(p, k + 1) & "," & crr(kk, 4)
- End If
- End If
- Next
- Next
- [a14].Resize(UBound(brr), 3) = brr
- End Sub
复制代码 |
|