Excel VBA: 从目标工作簿导入用户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

Function 删除从A6到H6开始的每一行中的非空单元格中的空格()
' 获取当前工作簿和工作表
Dim currentWorkbook As Workbook
Dim currentWorksheet As Worksheet
Set currentWorkbook = ThisWorkbook
Set currentWorksheet = currentWorkbook.ActiveSheet

' 获取A列到H列从A6开始的行范围
Dim rangeToDelete As Range
Set rangeToDelete = currentWorksheet.Range("A6:H" & currentWorksheet.Cells(rows.Count, 1).End(xlUp).Row)

' 遍历每一行，删除非空单元格中的空格
Dim row As Range
For Each row In rangeToDelete.Rows
    Dim cell As Range
    For Each cell In row.Cells
        If Not IsEmpty(cell) Then
            cell.Value = Trim(cell.Value)
        End If
    Next cell
Next row

' 清除对象引用
Set currentWorksheet = Nothing
Set currentWorkbook = Nothing
End Function