Sub 运行()
设置对话框.Show
End Sub
'添加处理模块
'源表字段名为要添加的数字标题名
Sub 添加处理(源表行数 As Long, 源比对字段名 As String, 源表字段名 As String, 目的表行数 As Long, 目的比对字段名 As String, 目的表字段名 As String)
ReDim 源数据(源表行数 - 1, 2)
ReDim 目的数据(目的表行数 - 1, 2)
Dim 源表比对列数 As Long
Dim 源表数据列数 As Long
Dim 目的表比对数据 As String
Dim 目的表数据列数 As Long
Dim 目的表比对列数 As Long
Dim 出错行数计数 As Long
Dim 是否找到 As Boolean
Dim 成功记录数 As Long
'查找字段所在列
源表比对列数 = 字段位置("源表", 源比对字段名)
If 源表比对列数 = 0 Then
MsgBox ("源表中不能找到此列" + 源比对字段名)
Exit Sub
End If
源表数据列数 = 字段位置("源表", 源表字段名)
If 源表数据列数 = 0 Then
MsgBox ("源表中不能找到此列" + 源表字段名)
Exit Sub
End If
目的表比对列数 = 字段位置("目的表", 目的比对字段名)
If 目的表比对列数 = 0 Then
MsgBox ("目的表中不能找到此列" + 源表字段名)
Exit Sub
End If
目的表数据列数 = 字段位置("目的表", 目的表字段名)
If 目的表数据列数 = 0 Then
MsgBox ("目的表中不能找到此列" + 目的表字段名)
Exit Sub
End If
'读入源表数据
Sheets("源表").Select
For i = 0 To 源表行数 - 2
源数据(i, 0) = Trim(Range(Cells(i + 2, 源表比对列数), Cells(i + 2, 源表比对列数)).Text)
源数据(i, 1) = Trim(Range(Cells(i + 2, 源表数据列数), Cells(i + 2, 源表数据列数)).Text)
Next
'读入目的表数据
Sheets("目的表").Select
For i = 0 To 目的表行数 - 2
目的数据(i, 0) = Trim(Range(Cells(i + 2, 目的表比对列数), Cells(i + 2, 目的表比对列数)).Text)
Next
出错行数计数 = 2
'查找数据
成功记录数 = 0
For i = 0 To 源表行数 - 2
是否找到 = False
For j = 0 To 目的表行数 - 2
If 目的数据(j, 0) = 源数据(i, 0) Then
目的数据(j, 1) = 源数据(i, 1)
成功记录数 = 成功记录数 + 1
是否找到 = True
Exit For
End If
Next
If 是否找到 = False Then
Sheets("出错表").Select
Range(Cells(出错行数计数, 1), Cells(出错行数计数, 1)).Value = 源数据(i, 0)
Range(Cells(出错行数计数, 2), Cells(出错行数计数, 2)).Value = 源数据(i, 1)
Range(Cells(出错行数计数, 3), Cells(出错行数计数, 3)).Value = "目的表中无此记录"
出错行数计数 = 出错行数计数 + 1
End If
Next
'添加数据
成功记录 = 0
Sheets("目的表").Select
For i = 2 To 目的表行数
If IsEmpty(目的数据(i - 2, 1)) = False Then
Range(Cells(i, 目的表数据列数), Cells(i, 目的表数据列数)).Value = 目的数据(i - 2, 1)
End If
Next
MsgBox ("记录数共" + Str(源表行数 - 1) + "。其中添加记录共" + Str(成功记录数) + "条，出错记录共" + Str(出错行数计数 - 2) + "条。" + Chr(13) + Chr(13) + " 出错信息请看出错表!!!")
End Sub
'查找字段名在表内位置模块
'表名为字段所在表
'字段名为要查找的字段
Function 字段位置(表名 As String, 字段名 As String)
Sheets(表名).Select
For i = 1 To 256
If Trim(Range(Cells(1, i), Cells(1, i)).Value) = Trim(字段名) Then
字段位置 = i
Exit Function
End If
Next
字段位置 = 0
End Function
设置对话框.Show
End Sub
'添加处理模块
'源表字段名为要添加的数字标题名
Sub 添加处理(源表行数 As Long, 源比对字段名 As String, 源表字段名 As String, 目的表行数 As Long, 目的比对字段名 As String, 目的表字段名 As String)
ReDim 源数据(源表行数 - 1, 2)
ReDim 目的数据(目的表行数 - 1, 2)
Dim 源表比对列数 As Long
Dim 源表数据列数 As Long
Dim 目的表比对数据 As String
Dim 目的表数据列数 As Long
Dim 目的表比对列数 As Long
Dim 出错行数计数 As Long
Dim 是否找到 As Boolean
Dim 成功记录数 As Long
'查找字段所在列
源表比对列数 = 字段位置("源表", 源比对字段名)
If 源表比对列数 = 0 Then
MsgBox ("源表中不能找到此列" + 源比对字段名)
Exit Sub
End If
源表数据列数 = 字段位置("源表", 源表字段名)
If 源表数据列数 = 0 Then
MsgBox ("源表中不能找到此列" + 源表字段名)
Exit Sub
End If
目的表比对列数 = 字段位置("目的表", 目的比对字段名)
If 目的表比对列数 = 0 Then
MsgBox ("目的表中不能找到此列" + 源表字段名)
Exit Sub
End If
目的表数据列数 = 字段位置("目的表", 目的表字段名)
If 目的表数据列数 = 0 Then
MsgBox ("目的表中不能找到此列" + 目的表字段名)
Exit Sub
End If
'读入源表数据
Sheets("源表").Select
For i = 0 To 源表行数 - 2
源数据(i, 0) = Trim(Range(Cells(i + 2, 源表比对列数), Cells(i + 2, 源表比对列数)).Text)
源数据(i, 1) = Trim(Range(Cells(i + 2, 源表数据列数), Cells(i + 2, 源表数据列数)).Text)
Next
'读入目的表数据
Sheets("目的表").Select
For i = 0 To 目的表行数 - 2
目的数据(i, 0) = Trim(Range(Cells(i + 2, 目的表比对列数), Cells(i + 2, 目的表比对列数)).Text)
Next
出错行数计数 = 2
'查找数据
成功记录数 = 0
For i = 0 To 源表行数 - 2
是否找到 = False
For j = 0 To 目的表行数 - 2
If 目的数据(j, 0) = 源数据(i, 0) Then
目的数据(j, 1) = 源数据(i, 1)
成功记录数 = 成功记录数 + 1
是否找到 = True
Exit For
End If
Next
If 是否找到 = False Then
Sheets("出错表").Select
Range(Cells(出错行数计数, 1), Cells(出错行数计数, 1)).Value = 源数据(i, 0)
Range(Cells(出错行数计数, 2), Cells(出错行数计数, 2)).Value = 源数据(i, 1)
Range(Cells(出错行数计数, 3), Cells(出错行数计数, 3)).Value = "目的表中无此记录"
出错行数计数 = 出错行数计数 + 1
End If
Next
'添加数据
成功记录 = 0
Sheets("目的表").Select
For i = 2 To 目的表行数
If IsEmpty(目的数据(i - 2, 1)) = False Then
Range(Cells(i, 目的表数据列数), Cells(i, 目的表数据列数)).Value = 目的数据(i - 2, 1)
End If
Next
MsgBox ("记录数共" + Str(源表行数 - 1) + "。其中添加记录共" + Str(成功记录数) + "条，出错记录共" + Str(出错行数计数 - 2) + "条。" + Chr(13) + Chr(13) + " 出错信息请看出错表!!!")
End Sub
'查找字段名在表内位置模块
'表名为字段所在表
'字段名为要查找的字段
Function 字段位置(表名 As String, 字段名 As String)
Sheets(表名).Select
For i = 1 To 256
If Trim(Range(Cells(1, i), Cells(1, i)).Value) = Trim(字段名) Then
字段位置 = i
Exit Function
End If
Next
字段位置 = 0
End Function
