VBA 导入用户ID:自动匹配并复制用户数据
该Sub过程的功能是导入用户ID,并自动将对应ID复制到当前工作簿。下面是该过程的详细解释:
- 调用'恢复A列字体颜色及填充色'过程,将A列单元格的字体颜色和填充色恢复为默认值。
- 获取当前工作簿和工作表对象。
- 判断B6单元格是否为空,如果为空则显示一个消息框提醒用户。
- 调用'删除从A6到H6开始的每一行中的非空单元格中的空格'过程,删除从A6到H6开始的每一行中非空单元格中的空格。
- 继续执行其余的代码。
- 创建文件选择器对象,并设置初始路径和文件类型过滤器。
- 显示文件选择器,并获取用户选择的目标工作簿路径。
- 检查是否选择了文件,如果没有选择则显示一个消息框提醒用户。
- 打开目标工作簿,并选择目标工作表。
- 获取当前工作表的B列从B6开始的列范围。
- 获取目标工作表的B列从B3开始向下的列范围。
- 遍历目标工作表的B列数据,进行匹配和复制操作。
- 调用'标注重复值'和'标注A列重复'过程,对A列和B列中的重复值进行标注。
- 保存并关闭目标工作簿。
- 清除对象引用。
- 调用'ID和姓名重复情况'过程,显示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
该代码使用清晰的注释,方便理解每个步骤的含义。此外,代码还包含了一些错误处理机制,以确保代码的稳定性和可靠性。
注意:
- 代码中使用了一些自定义的子过程,例如'恢复A列字体颜色及填充色'、'删除从A6到H6开始的每一行中的非空单元格中的空格'、'标注重复值'、'标注A列重复'、'ID和姓名重复情况'。这些子过程需要根据实际需求进行编写。
- 代码中使用了一些变量,例如'currentFolder'。这些变量需要根据实际情况进行设置。
- 代码中使用了一些常量,例如'msoFileDialogFilePicker'、'xlValues'、'xlWhole'。这些常量是VBA中内置的常量。
- 代码中使用了一些语句,例如'Set'、'Call'、'If'、'For Each'、'Next'。这些语句是VBA中常用的语句。
- 代码中使用了一些方法,例如'Range'、'Find'、'Offset'、'Cells'、'End'、'Clear'、'Add'、'Show'、'SelectedItems'、'Open'、'Close'。这些方法是VBA中对象的方法。
希望以上信息能够帮助您理解该Sub过程的功能和代码。
原文地址: http://www.cveoy.top/t/topic/gCW6 著作权归作者所有。请勿转载和采集!