本代码是一个 Sub 过程,用于导入用户ID。它包括以下步骤:

  1. 调用 '恢复A列字体颜色及填充色' 的过程,用于将A列的字体颜色和填充色恢复为默认值。
  2. 获取当前工作簿和工作表的引用。
  3. 检查B6单元格是否为空,如果为空则弹出一个消息框提示用户没有姓名信息。
  4. 调用 '删除从A6到H6开始的每一行中的非空单元格中的空格' 的过程,用于删除A6到H6开始的每一行中非空单元格中的空格。
  5. 继续执行其余的代码:
    • 创建文件选择器对象并设置初始路径、允许选择多个文件以及文件类型过滤器。
    • 显示文件选择器并获取选择的文件路径。
    • 检查是否选择了文件,如果没有则弹出一个消息框提示用户未选择目标工作簿路径。
    • 打开目标工作簿。
    • 选择目标工作表。
    • 获取当前工作表的B列从B6开始的列范围。
    • 获取目标工作表的B列从B3开始向下的列范围。
    • 遍历目标工作表的B列数据,进行匹配和复制。如果找到匹配项,则将目标工作表的A列数据复制到当前工作表的A列。
    • 调用 '标注重复值' 的过程,用于标注重复值。
    • 调用 '标注A列重复' 的过程,用于标注A列重复。
    • 保存并关闭目标工作簿。
    • 清除对象引用。
    • 调用 'ID和姓名重复情况' 的过程,用于显示ID和姓名重复的情况。

请注意,上述代码中的一些过程(如 '恢复A列字体颜色及填充色'、'删除从A6到H6开始的每一行中的非空单元格中的空格'、'标注重复值'、'标注A列重复'、'ID和姓名重复情况')并未提供具体的实现,您需要根据自己的需求自行编写这些过程的代码。

Sub 导入用户ID()
    Call 恢复A列字体颜色及填充色
    ' 获取当前工作簿和工作表
    Dim currentWorkbook As Workbook
    Dim currentWorksheet As Worksheet
    Set currentWorkbook = ThisWorkbook
    Set currentWorksheet = currentWorkbook.ActiveSheet

    ' 判断B6单元格是否为空
    Dim cellB6 As Range
    Set cellB6 = currentWorksheet.Range('B6')
    If cellB6.Value = '' Then
        MsgBox '没有姓名信息,你导什么。你是不是想导入党费系统内的基础信息。', vbExclamation
        Exit Sub
    End If

    ' 调用删除从A6到H6开始的每一行中的非空单元格中的空格的子过程
    Call 删除从A6到H6开始的每一行中的非空单元格中的空格

    ' 其余代码继续执行...
    Dim targetWorkbook As Workbook
    Dim targetWorksheet As Worksheet
    Dim currentRange As Range
    Dim targetRange As Range
    Dim currentCell As Range
    Dim targetCell As Range
    Dim lookupValue As Variant
    Dim resultCell As Range
    Dim sourceValue As Variant
    Dim targetWorkbookPath As String

    ' 创建文件选择器对象
    Dim fileDialog As fileDialog
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)

    ' 设置文件选择器的初始路径
    fileDialog.InitialFileName = currentFolder

    ' 允许选择多个文件
    fileDialog.AllowMultiSelect = True

    ' 设置文件选择器的文件类型过滤器
    fileDialog.Filters.Clear
    fileDialog.Filters.Add 'Excel数据文件', '*.xls*'

    ' 显示文件选择器并获取选择的文件路径
    If fileDialog.Show = -1 Then ' 用户点击确定按钮
        ' 获取选择的目标工作簿路径
        targetWorkbookPath = fileDialog.SelectedItems(1)
    Else ' 用户点击取消按钮
        Exit Sub ' 直接退出当前 VBA 代码的执行
    End If

    ' 检查是否选择了文件
    If Len(targetWorkbookPath) = 0 Then
        MsgBox '未选择目标工作簿路径。', vbExclamation
        Exit Sub
    End If

    ' 打开目标工作簿
    Set targetWorkbook = Workbooks.Open(targetWorkbookPath)

    ' 选择目标工作表
    Set targetWorksheet = targetWorkbook.Sheets(1) ' 替换为实际的目标工作表

    ' 获取当前工作表的B列从B6开始的列范围
    Set currentRange = currentWorksheet.Range('B6:B' & currentWorksheet.Cells(rows.count, 2).End(xlUp).Row)

    ' 获取目标工作表的B列从B3开始向下的列范围
    Set targetRange = targetWorksheet.Range('B3:B' & targetWorksheet.Cells(rows.count, 2).End(xlUp).Row)

    ' 遍历目标工作表的B列数据,进行匹配和复制
    For Each targetCell In targetRange
        lookupValue = targetCell.Value
        Set resultCell = currentRange.Find(lookupValue, LookIn:=xlValues, LookAt:=xlWhole)

        If Not resultCell Is Nothing Then
            sourceValue = targetCell.Offset(0, -1).Value ' 偏移1列获取目标工作表的A列数据
            resultCell.Offset(0, -1).Value = sourceValue ' 偏移1列复制到当前工作表的A列
        End If
    Next targetCell
  
    Call 标注重复值
    Call 标注A列重复
    ' 保存并关闭目标工作簿
    targetWorkbook.Close SaveChanges:=True

    ' 清除对象引用
    Set targetWorksheet = Nothing
    Set targetWorkbook = Nothing
    Set currentWorksheet = Nothing
    Set currentWorkbook = Nothing
    Call ID和姓名重复情况
    

End Sub

原文地址: https://www.cveoy.top/t/topic/gAGb 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录