VBA学习笔记本(二)——两个表格数据匹配

最近遇到很多要在两个表之间同步数据的情况,比如在sheet1 为基础表 表中有非常多的字段

姓名学号班级专业性别年龄籍贯
张A001一班计算机15北京
王B002一班物理30上海
张C003一班采矿18北京
李E004一班软件20北京
秦F005一班财会26北京

而在Sheet2中却只有如下数据

姓名学号班级专业性别年龄籍贯
张A001
张C003
李E004
秦F005

Sheet2中的信息不全,需要补充完整,所以就需要VBA进行快速匹配,但是如果为了通用性,不仅仅局限于这个两张表中,就增加了一些功能。首先建立一个窗体增加如下控件:
《VBA学习笔记本(二)——两个表格数据匹配》
三个下拉框分别为选取需要匹配的工作表,也就是本立中的Sheet2,另一个作为基准表,也就是本利中的Sheet1,二基准字段为两个表中匹配时作为关联的一个字段,本利中未学号,需要为唯一值。

新建一个模块,用于存放基础方法,共需建立一个窗口一个模块
《VBA学习笔记本(二)——两个表格数据匹配》

基础功能模块中算法如下:

Function 获取表头数组(表名)
     '''本方法作用是输入表名,返回对应表中首行表头组成的数组
     '''使用了字典的作用是为了去重
     '关闭页面刷新
    Application.ScreenUpdating = False
    Sheets(表名).Select
    With Sheets(表名)
        表行数 = Sheets(表名).UsedRange.Rows.Count
        表列数 = Sheets(表名).UsedRange.Columns.Count
        表头数组 = Sheets(表名).Range(Cells(1, 1), Cells(1, 表列数)).Value
        Dim 表头字典 As Object '声明字典对象,亦可通过声明变体型变量完成声明 >>> Dim d
        Set 表头字典 = CreateObject("Scripting.Dictionary")    '声明字典
        For i = 1 To 表列数
            表头字典(Sheets(表名).Cells(1, i) & "") = i
        Next i
        Dim 表数组()
        表数组 = Sheets(表名).Range(Cells(1, 1), Cells(表行数, 表列数)).Value
        表数组行数 = UBound(表数组) - LBound(表数组) + 1
    End With
    '通过字典转化后可以实现去除的目的
    表头数组 = 表头字典.Keys
    Application.ScreenUpdating = True
    获取表头数组 = 表头数组
End Function
Function 同步表内容(需同步表, 基准表, 基准字段)
	'''本方法作用为同步两个表的数据,需输入需同步表,基准表,基准字段三个参数
    '关闭页面刷新
    Application.ScreenUpdating = False
    '加上选中工作表,可以减少一些不必要的错误,比如在数组赋值的时候如果不是选中工作表中就会报错
    Sheets(需同步表).Select
    '用with可以减少引用,方便书写,也可以小幅度的提高速度
    With Sheets(需同步表)
        '获取表中有数据的行数和列数
        需同步表行数 = .UsedRange.Rows.Count
        需同步表列数 = .UsedRange.Columns.Count
        '将需同步表的表头放入数组
        需同步表头数组 = .Range(Cells(1, 1), Cells(1, 需同步表列数)).Value
        '将表头内容存入字典
        Dim 需同步表头字典 As Object '声明字典对象,亦可通过声明变体型变量完成声明 >>> Dim d
        Set 需同步表头字典 = CreateObject("Scripting.Dictionary")    '声明字典
        For i = 1 To 需同步表列数
            需同步表头字典(Sheets(需同步表).Cells(1, i) & "") = i
        Next i
        '将需同步表内数据放入数组
        Dim 需同步表数组()
        需同步表数组 = .Range(Cells(1, 1), Cells(需同步表行数, 需同步表列数)).Value
        需同步表数组行数 = UBound(需同步表数组) - LBound(需同步表数组) + 1
    End With
    
    Sheets(基准表).Select
    With Sheets(基准表)
        基准表行数 = Sheets(基准表).UsedRange.Rows.Count
        基准表列数 = Sheets(基准表).UsedRange.Columns.Count
        基准表头数组 = Sheets(基准表).Range(Cells(1, 1), Cells(1, 基准表列数)).Value
        Dim 基准表头字典 As Object '声明字典对象,亦可通过声明变体型变量完成声明 >>> Dim d
        Set 基准表头字典 = CreateObject("Scripting.Dictionary")    '声明字典
        For i = 1 To 基准表列数
            基准表头字典(Sheets(基准表).Cells(1, i) & "") = i
        Next i
        Dim 基准表数组()
        基准表数组 = Sheets(基准表).Range(Cells(1, 1), Cells(基准表行数, 基准表列数)).Value
        基准表数组行数 = UBound(基准表数组) - LBound(基准表数组) + 1
    End With
    
    '将需同步表头的内容字典的所有key,放入数组中
    需同步表头字典keys = 需同步表头字典.Keys
    '通过循环来判断是否相等及赋值
    For i = 2 To 需同步表数组行数
        For j = 2 To 基准表数组行数
            If 需同步表数组(i, 需同步表头字典(基准字段)) = 基准表数组(j, 基准表头字典(基准字段)) Then
                '通过循环,为每一行的每个单元格进行赋值
                For m = 0 To UBound(需同步表头字典keys) - 1
                    If 基准表头字典.exists(需同步表头字典keys(m)) Then 'exists是用来判断字典中是否存在某个kye,用此方法比循环效率更高
                        Sheets(需同步表).Cells(i, 需同步表头字典(需同步表头字典keys(m))) = 基准表数组(j, 基准表头字典(需同步表头字典keys(m)))
                    End If
                Next m
            End If
        Next j
    Next i
    
    Sheets(需同步表).Select
    '打开屏幕刷新输出结果
    Application.ScreenUpdating = True
    '返回函数值
    同步表内容 = "数据同步处理完成!"
    
End Function

读取表名按钮方法:

Private Sub 读取表名按钮_Click()
    '''读取当前工作簿中所有的工作表,并且赋值给对应的下拉框控件
    '重置下拉框内容
    ComboBox_需匹配表.Clear
    ComboBox_基准表.Clear
    '通过循环,获取工作表序号,然后将其名字放入下拉框控件中
    For i = 1 To Sheets.Count
        '在下拉框控件中加入内容
        ComboBox_需匹配表.AddItem (Sheets(i).Name)
        ComboBox_基准表.AddItem (Sheets(i).Name)
    Next i
End Sub

在需求匹配表内容选择后,基准字段下拉框中添加对应表头信息

'下拉框变化事件,当某下拉框内容变化后触发此事件
Private Sub ComboBox_需匹配表_change()
    
    表头数组 = 基础功能模块.获取表头数组(ComboBox_需匹配表.Text)
    'Debug.Print (ComboBox_需匹配表.Text & "_" & 表头数组(0))
    表头数组长度 = UBound(表头数组) - LBound(表头数组)
    For i = 0 To 表头数组长度
        '在下拉框控件中加入内容
        ComboBox_基准字段.AddItem (表头数组(i))
    Next i
End Sub

匹配内容按钮主要功能是调用函数进行计算

Private Sub 匹配内容按钮_Click()
    需同步表名 = ComboBox_需匹配表.Text
    基准表名 = ComboBox_基准表.Text
    基准字段 = ComboBox_基准字段.Text
    返回信息 = 基础功能模块.同步表内容(需同步表名, 基准表名, 基准字段)
    MsgBox (返回信息)
End Sub

综上以上即可实现通用的数据匹配,但是前提是两个工作表的表头字段是一样的,表头顺序无所谓,但是名称一定一样。

示例文件:https://download.csdn.net/download/huaqitaishao/12325721

    原文作者:huaqitaishao
    原文地址: https://blog.csdn.net/huaqitaishao/article/details/105500043
    本文转自网络文章,转载此文章仅为分享知识,如有侵权,请联系博主进行删除。
点赞