学以致用——使用VBA开发人才信息查询及维护系统（CV Management System developed in VBA）

最新推荐文章于 2023-07-02 06:48:17 发布

预见未来to50

最新推荐文章于 2023-07-02 06:48:17 发布

阅读量643

点赞数 1

分类专栏：学以致用—实用程序（iApps） Excel技巧及VBA编程（Excel_VBA）

本文链接：https://blog.csdn.net/hpdlzu80100/article/details/99494026

版权

Excel技巧及VBA编程（Excel_VBA）同时被 2 个专栏收录

404 篇文章 171 订阅

订阅专栏

学以致用—实用程序（iApps）

94 篇文章 2 订阅

订阅专栏

需求说明：

当简历数量很多时，筛选符合条件的简历是一件苦差事。

本系统旨在帮助用户便捷、高效的查询、维护（增删改）人才信息，提供以下功能：

1. 提取保存在Windows系统文件夹中的不同类型的简历列表到Excel表中（参考另一篇文章：学以致用——VBA提取文件名到Excel中（Extract File Names to Excel) ）

2. 合并、更新保存在不同工作表中的不同类型简历列表到总表

3. 在总表中，选择一个具体的简历文件名称，即可在Excel中直接打开该文件（相当于实现了资源管理器的部分功能）

4. 在总表中进行人才信息的输入和维护（根据打开的简历文件中的具体信息，更新主要的人才信息，如专业、当前职位等）

5. 当录入的人才信息足够多时，即可形成一个强大的人才库

6. 支持用户在用户界面上自由增加、删除一些列。（使用列号查询函数，可动态查询关键列所在列号）

主体代码如下:

Sub updateFileList()
'Developed by PDH on 20190720
'用法说明：更新文件列表（包括不同的简历类型的合并）

Application.ScreenUpdating = False  '关闭屏幕刷新

Dim lastRow_UI_Before As Long   '人才信息查询及维护表中的有效数据行数（添加新记录之前）
Dim lastRow_UI_After As Long   '人才信息查询及维护表中的有效数据行数（添加新记录之后）
Dim lastRow_Summary As Long   '更新简历工作表（汇总表）中的有效数据行数
Dim lastRow_Rival As Long   '竞争对手简历工作表中的有效数据行数
Dim lastRow_Temporary As Long   '临时下载简历工作表中的有效数据行数
Dim lastRow_Expiring As Long   '到期下载简历工作表中的有效数据行数
Dim columnName_FileName As String   '简历文件名所在列的列标
Dim columnName_FileType As String   '简历类型所在列的列标
Dim objworkBook As Workbook     '声明工作簿变量
Dim objWorkSheet As Worksheet   '声明工作表变量
Dim ColumnTitleName_FileName As String  '声明要查找的列的列标题（简历文件名）
Dim ColumnTitleName_FileType As String  '声明要查找的列的列标题（简历类型）
Dim columnNumber_FileName_UI As Integer     '声明列号（列标）变量 （简历文件名）
Dim columnName_FileName_UI As String        '声明列名变量 （简历文件名）
Dim columnNumber_FileType_UI As Integer     '声明列号（列标）变量 （简历类型）
Dim columnName_FileType_UI As String        '声明列名变量 （简历类型）
 
Set objworkBook = ThisWorkbook  '指定工作簿
Set objWorkSheet = objworkBook.Sheets("人才信息查询及维护")   '指定工作表
ColumnTitleName_FileName = "简历文件名"  '指定要查找的列标题
ColumnTitleName_FileType = "简历类型"  '指定要查找的列标题
 
columnNumber_FileName_UI = intFindColumnID(1, objworkBook, objWorkSheet, ColumnTitleName_FileName) '调用列号查找函数
columnName_FileName_UI = Application.Evaluate("=Substitute(Address(1," & columnNumber_FileName_UI & ", 4), ""1"", """")")   '使用Substitute函数将类似"D1"这样得单元格地址中的1替换为空白字符（即，删除数字1，仅留下列名（字母A至XFD）,对应1至10384）

columnNumber_FileType_UI = intFindColumnID(1, objworkBook, objWorkSheet, ColumnTitleName_FileType) '调用列号查找函数
columnName_FileType_UI = Application.Evaluate("=Substitute(Address(1," & columnNumber_FileType_UI & ", 4), ""1"", """")")   '使用Substitute函数将类似"D1"这样得单元格地址中的1替换为空白字符（即，删除数字1，仅留下列名（字母A至XFD）,对应1至10384）

columnName_FileName = "H"   '根据文档实际排版赋值
columnName_FileType = "G"   '根据文档实际排版赋值


lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '获取最后一行的行号
lastRow_Rival = ThisWorkbook.Sheets("竞争对手简历").Range("a65536").End(xlUp).Row   '获取最后一行的行号
lastRow_Temporary = ThisWorkbook.Sheets("临时简历").Range("a65536").End(xlUp).Row   '获取最后一行的行号
lastRow_Expiring = ThisWorkbook.Sheets("到期下载简历").Range("a65536").End(xlUp).Row   '获取最后一行的行号

'复制前先清空数据（保留标题和示例行）
ThisWorkbook.Sheets("更新简历列表").Range("A3:" & columnName_FileName & lastRow_Summary).ClearContents

'复制竞争对手简历
ThisWorkbook.Sheets("竞争对手简历").Range("A2:A" & lastRow_Rival).Copy
ThisWorkbook.Sheets("更新简历列表").Activate
ActiveSheet.Range(columnName_FileName & "3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveSheet.Range(columnName_FileType & "3:" & columnName_FileType & (lastRow_Rival + 1)).Value = "竞争对手简历" '简历类型为竞争对手简历
lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '重新获取最后一行的行号

'复制临时简历
ThisWorkbook.Sheets("临时简历").Range("A2:A" & lastRow_Temporary).Copy
ThisWorkbook.Sheets("更新简历列表").Activate
ActiveSheet.Range(columnName_FileName & (lastRow_Summary + 1)).Select   '从下一行开始复制
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '重新获取最后一行的行号
ActiveSheet.Range(columnName_FileType & (lastRow_Rival + 2) & ":" & columnName_FileType & lastRow_Summary).Value = "临时简历" '简历类型为临时简历
lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '重新获取最后一行的行号

'复制到期下载简历
ThisWorkbook.Sheets("到期下载简历").Range("A2:A" & lastRow_Expiring).Copy
ThisWorkbook.Sheets("更新简历列表").Activate
ActiveSheet.Range(columnName_FileName & (lastRow_Summary + 1)).Select   '从下一行开始复制
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '重新获取最后一行的行号
ActiveSheet.Range(columnName_FileType & (lastRow_Rival + lastRow_Temporary + 1) & ":" & columnName_FileType & lastRow_Summary).Value = "到期下载简历" '简历类型为临时简历

'复制公式并向下填充
With ActiveSheet
    .Range("A2:F2").Select
    Selection.Copy
    .Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("A3:F" & lastRow_Summary)
    '设置格式
    .Range("A1:" & columnName_FileName & lastRow_Summary).Borders.LineStyle = xlContinuous
    .Range("A3").Select '复制结束，光标回到A3单元格
    .Range("M2").Value = Format(Now, "YYYY-MM-DD HH:MM:SS")   '添加更新时间戳
End With

'将更新后新识别的文件的信息（包括从文件名提取的公司名、姓名、岗位、渠道信息）等复制到主数据表
'筛选出新识别的文件
lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '重新获取最后一行的行号
ThisWorkbook.Sheets("更新简历列表").Activate
ActiveSheet.Range("A3:H" & lastRow_Summary).AutoFilter Field:=6, Criteria1:="Y" '筛选出New?列为"Y"的记录

If ActiveSheet.Range("A3:H" & lastRow_Summary).SpecialCells(xlCellTypeVisible).Rows.Count >= 1 Then '仅当有新纪录时才更新主表
    ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Select '复制可见单元格
    Selection.Copy
    ThisWorkbook.Sheets("人才信息查询及维护").Activate
    lastRow_UI_Before = ActiveSheet.Range("C65536").End(xlUp).Row   '获取人才信息查询及维护表最后一行的行号
    With ActiveSheet
        .Range("A" & lastRow_UI_Before + 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        lastRow_UI_After = ActiveSheet.Range("C65536").End(xlUp).Row   '获取人才信息查询及维护表最后一行的行号（添加新纪录后）
        .Range("G" & (lastRow_UI_Before + 1) & ":H" & lastRow_UI_After).Copy
        .Range(columnName_FileType_UI & (lastRow_UI_Before + 1)).Select '复制简历类型
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        .Range(columnName_FileType_UI & (lastRow_UI_Before + 1) & ":" & columnName_FileType_UI & lastRow_UI_After).Offset(0, -1).Value = Format(Now, "YYYY-MM-DD HH:MM:SS") '添加更新时间戳
        .Range("F" & (lastRow_UI_Before + 1) & ":H" & lastRow_UI_After).ClearContents '清除多余内容
        '设置格式
        lastRow_Summary = ThisWorkbook.Sheets("更新简历列表").Range(columnName_FileName & "65536").End(xlUp).Row   '重新获取最后一行的行号
        .Range("A1:" & columnName_FileName_UI & lastRow_Summary).Borders.LineStyle = xlContinuous
        .Range("A2").Select '复制结束，光标回到A3单元格
        .Range(columnName_FileType_UI & "1").Offset(0, 7).Value = "最近更新： " & Format(Now, "YYYY-MM-DD HH:MM:SS") '添加更新时间戳
    End With
    
End If

ThisWorkbook.Sheets("更新简历列表").ShowAllData
'
Application.ScreenUpdating = True  '恢复屏幕刷新

End Sub

用户界面缩略图：