信息表合并

李桥贵

老师 ，辛苦你一下，帮我编写代码，谢谢！

信息合并.zip (53.22 KB, 下载次数: 20)

2024-10-25 23:34 上传

点击文件名下载附件

z865593849

体力活 ，写了一半写不下去了

zpy2

//select * from consolidateSheet where f01 like '%教育%'  limit 200;
create temp table aa as
select f04,f05 性别,f06 名称 from consolidateSheet where f01 like '%基本%' and f04 not like '姓名' and f04 not like '-';
select * from aa;
create temp table bb as
select f04,f05 原始学历,colIndex[6:9] from consolidateSheet where f01 like '%教育%' and f04 not like '姓名' and f04 not like '-';
select * from bb;
create temp table cc as
select f04,colIndex[6:12]  from consolidateSheet where f01 like '%职称%' and f04 not like '姓名' and f04 not like '-';
select * from cc;
select * from aa left join bb using(f04) left join cc using(f04);

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, j&, r&, dic As Object, iPosRow&
    Dim strPath$, strFileName$, wks As Worksheet
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    strPath = ThisWorkbook.Path & "\"
    With [A1].CurrentRegion
        .Offset(5).Clear 'Contents
        ar = .Resize(10 ^ 3).Value
        r = 5
    End With
   
    strFileName = strPath & "教师基本信息.xls"
    If Dir(strFileName) <> "" Then
        With GetObject(strFileName)
            For Each wks In .Worksheets
                br = wks.[A1].CurrentRegion.Value
                For i = 3 To UBound(br)
                    If Len(br(i, 2)) Then
                        r = r + 1
                        For j = 2 To UBound(br, 2)
                            ar(r, j) = br(i, j)
                        Next j
                        dic(br(i, 2)) = r
                        ar(r, 1) = r - 5
                    End If
                Next i
            Next
            .Close False
        End With
    End If
   
    strFileName = strPath & "教师教育信息.xls"
    If Dir(strFileName) <> "" Then
        With GetObject(strFileName)
            For Each wks In .Worksheets
                br = wks.[A1].CurrentRegion.Value
                For i = 4 To UBound(br)
                    If Len(br(i, 2)) Then
                        If Not dic.exists(br(i, 2)) Then
                            r = r + 1
                            ar(r, 1) = r - 5
                            ar(r, 2) = br(i, 2)
                            dic(br(i, 2)) = r
                        End If
                        iPosRow = dic(br(i, 2))
                        For j = 3 To UBound(br, 2)
                            ar(iPosRow, j + 10) = br(i, j)
                        Next j
                    End If
                Next i
            Next
            .Close False
        End With
    End If
   
    strFileName = strPath & "教师职称信息.xls"
    If Dir(strFileName) <> "" Then
        With GetObject(strFileName)
            For Each wks In .Worksheets
                br = wks.[A1].CurrentRegion.Value
                For i = 5 To UBound(br)
                    If Len(br(i, 2)) Then
                        If Not dic.exists(br(i, 2)) Then
                            r = r + 1
                            ar(r, 1) = r - 5
                            ar(r, 2) = br(i, 2)
                            dic(br(i, 2)) = r
                        End If
                        iPosRow = dic(br(i, 2))
                        For j = 5 To UBound(br, 2)
                            ar(iPosRow, j + 16) = br(i, j)
                        Next j
                    End If
                Next i
            Next
            .Close False
        End With
    End If
   
    [A1].Resize(r, UBound(ar, 2)) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

李桥贵

gwjkkkkk 发表于 2024-10-26 11:43
请参考。。。

老师其中有同名同姓但性别不同，如果每个表中都有身份证号能匹配吗，谢谢。
信息合并(同名同姓).rar (54.6 KB, 下载次数: 5)

2024-10-27 08:46 上传

点击文件名下载附件

gwjkkkkk

李桥贵 发表于 2024-10-27 07:31
老师其中有同名同姓但性别不同，如果每个表中都有身份证号能匹配吗，谢谢。

其实用身份证号码最好，能做到唯一性，否则有同名同性会导到匹配错位。

gwjkkkkk

李桥贵 发表于 2024-10-27 07:31
老师其中有同名同姓但性别不同，如果每个表中都有身份证号能匹配吗，谢谢。

请参考。。。

chxw68

参与一下。