yhd_Excel VBA之税务系统与工资表比较不同

Sub 税务系统与工资表比较不同()

Dim dic_a As Object, dic_b As Object, asht As Worksheet, bsht As Worksheet

Dim i, j, k

Dim a_rr, b_rr

''=========在此设置最数据===========

ashtname = "11月工资" '''设置第一个工作表###一般放置工资表

a_col = "D" '''设置第一个工作表的“身份证”所在的列

a_start_n = 1 '''设置第一个工作表的标题行数

bshtname = "税务" '''设置第二个工作表,####一般设置为“公积金”或“税务系统”导出的数据

b_col = "D" '''设置第二个工作表中“身份证”所在的列

b_start_n = 1 '''设置第二个工作表中的标题行数

''=========设置最数据END===========

Set dic_a = CreateObject("scripting.dictionary")

Set dic_b = CreateObject("scripting.dictionary")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'Application.AskToUpdateLinks = False

ti = Timer

Set asht = Worksheets(ashtname)

Set bsht = Worksheets(bshtname)

asht_lastrow = asht.Cells.Find("*", , , , 1, 2).Row

asht_lastcol = asht.Cells.Find("*", , , , 2, 2).Column 1

bsht_lastrow = bsht.Cells.Find("*", , , , 1, 2).Row

bsht_lastcol = bsht.Cells.Find("*", , , , 2, 2).Column 1

'----------此处设定为工资表，工资表的姓名与身份证在C:D列------------------

a_rr = asht.Range("C" & a_start_n 1 & ":D" & asht_lastrow)

For i = 1 To UBound(a_rr)

If a_rr(i, 1) <> "" Then

s = a_rr(i, 1) & "_" & UCase(a_rr(i, 2))

dic_a(s) = i a_start_n

End If

Next i

'-------设定为税务系统导出的数据表，姓名在B列，证照号码在D列---------

b_rr = bsht.Range("B" & b_start_n 1 & ":D" & bsht_lastrow)

For i = 1 To UBound(b_rr)

If b_rr(i, 1) <> "" Then

s = b_rr(i, 1) & "_" & UCase(b_rr(i, 3))

dic_b(s) = i b_start_n

End If

Next i

'======检查那一位是：“税务系统”有，工资表中没，是"退休或辞职"的，是要删除的

'----用 b_rr 来检测是否包含有 a_rr

For j = 1 To UBound(b_rr)

s = b_rr(j, 1) & "_" & UCase(b_rr(j, 3))

If dic_a.exists(s) Then

bsht.Cells(j b_start_n, bsht_lastcol) = "在"

Else

bsht.Cells(j b_start_n, bsht_lastcol) = ashtname & "表中不存在"

End If

Next j

''=========检查那一位是：工资表中有，税务系统中没，也就是要新增的

'----------用 a_rr 来检测是否包含有 b_rr----------------

For j = 1 To UBound(a_rr)

s = a_rr(j, 1) & "_" & UCase(a_rr(j, 2))

If dic_b.exists(s) Then

asht.Cells(j a_start_n, asht_lastcol) = "在" ''''''b_rr(dic_b(a_rr(j, 1)), 4)

Else

asht.Cells(j a_start_n, asht_lastcol) = bshtname & "表中不存在"

End If

Next j

Application.ScreenUpdating = True

Application.DisplayAlerts = True

'Application.AskToUpdateLinks = True

MsgBox "操作完成" & Format(Timer - ti, "0.00") & "秒"

End Sub

====此代码 自己保存 留用====