用VB在Excel中实现数据查找调用并校验

用VB在Excel中实现数据查找调用并校验

Sub 按钮3_单击()

Application.ScreenUpdating = False '关闭屏幕

Sheets(\"信息表\").Select

Cells(4, 20) = 1

Columns(\"U:U\").Select '对单位进行筛选

Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:=\"=1\

Range(\"K5:K4003\").Select

Selection.ClearContents

Sheets(\"银行卡号\").Select

Range(\"Z5:Z4003\").Select

Selection.ClearContents

Sheets(\"信息表\").Select

Dim i, j, k, m, n As Integer

n = Cells(2, 22).Value + 5

Cells(6, 25) = \"查找银行卡号并导入\"

For m = 5 To n

Sheets(\"信息表\").Select

Cells(7, 26) = m - 4

Application.ScreenUpdating = True '重新打开屏幕

Cells(1, 2) = Cells(8, 26)

Range(Cells(m, 6), Cells(m, 6)).Select

Application.ScreenUpdating = False '关闭屏幕

Cells(2, 25) = Cells(m, 6)

Cells(2, 26) = Cells(m, 3)

Cells(m, 8) = Cells(3, 27)

If Cells(3, 26) > 1 Then

Cells(m, 11) = \"同校同名\"

End If

Sheets(\"银行卡号\").Select

j = Cells(4, 24) + 4

Cells(j, 26) = 1

Sheets(\"信息表\").Select

Next m

Cells(6, 25) = \"为零银行卡号复查导入\"

For k = 5 To n

Sheets(\"信息表\").Select

Cells(7, 26) = k - 4

Application.ScreenUpdating = True '重新打开屏幕

Cells(1, 2) = Cells(8, 26)

Range(Cells(k, 6), Cells(k, 6)).Select

Application.ScreenUpdating = False '关闭屏幕

If Cells(k, 8) = 0 Then

Cells(2, 25) = Cells(k, 6)

Cells(2, 26) = Cells(k, 3)

Cells(k, 8) = Cells(3, 28)

If Cells(3, 28) <> 0 Then

Cells(k, 11) = \"校名不同\"

End If

Sheets(\"银行卡号\").Select

j = Cells(4, 24) + 4

Cells(j, 26) = 1

Sheets(\"信息表\").Select

End If

Next k

Cells(6, 25) = \"重复银行卡号核查\"

For i = 5 To n

Sheets(\"信息表\").Select

Cells(7, 26) = i - 4

Application.ScreenUpdating = True '重新打开屏幕

Cells(1, 2) = Cells(8, 26)

Range(Cells(i, 6), Cells(i, 6)).Select

Application.ScreenUpdating = False '关闭屏幕

Cells(4, 29) = Cells(i, 6)

Cells(4, 30) = Cells(i, 8)

If Cells(4, 31) > 1 Or Cells(2, 32) > 0 Then

Cells(i, 11) = \"重复发放\"

End If

If Cells(i, 8) = 0 Then

Cells(i, 11) = \"没有发放\"

End If

Next i

Cells(4, 20) = 0

Columns(\"U:U\").Select

Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:=\"=1\

Cells(1, 2) = \"\"

Application.ScreenUpdating = True '重新打开屏幕

Range(\"A5\").Select

MsgBox \" 计算机查找及校验结束，请根据查找提示修正!\"

End Sub