|
|
ub 匹配信息()
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim brr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("1帮扶")
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar1 = .Range("a1:c" & r)
End With
For i = 3 To UBound(ar1)
If Trim(ar1(i, 3)) <> "" Then
d(ar1(i, 3)) = i
End If
Next i
With Sheets("3信息表")
ws = .Cells(Rows.Count, 1).End(xlUp).Row
ar2 = .Range("a1:d" & ws)
End With
For i = 3 To UBound(ar2)
If Trim(ar2(i, 2)) <> "" Then
d(ar2(i, 2)) = i
End If
Next i
With Sheets("2户内成员")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
ar3 = .Range("a1:d" & rs)
End With
ReDim brr(1 To UBound(ar3), 1 To 7)
For i = 3 To UBound(ar3)
If Trim(ar3(i, 2)) = "户主" Then
ar3(i, 4) = ar3(i, 3)
End If
If Trim(ar3(i, 4)) = "" Then ar3(i, 4) = ar(i - 1, 4)
Next i
For i = 3 To UBound(ar1)
If Trim(ar1(i, 3)) <> "" Then
For s = 3 To UBound(ar3)
If ar1(i, 3) = ar3(s, 4) Then
n = n + 1
brr(n, 1) = ar1(i, 1)
brr(n, 2) = ar1(i, 2)
brr(n, 3) = ar1(i, 3)
brr(n, 4) = ar3(s, 1)
brr(n, 5) = ar3(s, 3)
xh = d(ar3(s, 3))
If xh <> "" Then
brr(n, 6) = ar2(xh, 3)
brr(n, 7) = ar2(xh, 4)
End If
End If
Next s
End If
Next i
With Sheets("4结果")
.UsedRange.Offset(2) = Empty
.[a3].Resize(n, 7) = brr
End With
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-12-8 00:38
楼主
