Sub Sample()
Dim sfzs As New Collection
Dim ws, wbs, dbs As Worksheet
Dim r As Long
Set ws = ThisWorkbook.Sheets("Sheet 1")
Set wbs = ThisWorkbook.Sheets("五保")
Set dbs = ThisWorkbook.Sheets("低保")
'Set dg = ws.Range("c2:c37573")
Set dg = ws.Range("c:c")
'Set dg = ws.Columns("C")
Application.ScreenUpdating = False
With wbs
For r = To
If dg.Find(.Range("D" & r).Value) Is Nothing Then
.Range("f" & r).Value = "没在"
Else
.Range("f" & r).Value = "在"
End If
Next r
End With
With dbs
For r = To
If dg.Find(.Range("D" & r).Value) Is Nothing Then
.Range("f" & r).Value = "没在"
Else
.Range("f" & r).Value = "在"
End If
Next r
End With
Application.ScreenUpdating = True
End Sub