基于VLookup结果通过VBA UserForm修改数据的实现求助

下午好！我来帮你完成这个日期更新的功能。你的UserForm已经实现了通过ComboBox选择用户并加载到期日期的基础功能，现在只需要完善CmdChangedate_Click事件的代码，就能把修改后的日期写回对应的单元格中。

实现思路 #

• 根据ComboBox选中的用户名，在Lede Lys工作表的A列找到对应的行号
• 将修改后的日期写入该行的第10列（对应VLookup中使用的第10列）
• 增加错误处理，避免因未找到匹配项导致的程序报错
• 给用户反馈操作结果（成功/失败提示）

完整的CmdChangedate_Click代码 #

Private Sub CmdChangedate_Click()
    Dim userName As String
    Dim matchRow As Variant
    Dim targetSheet As Worksheet
    
    ' 设置目标工作表
    Set targetSheet = ThisWorkbook.Worksheets("Lede Lys")
    ' 获取ComboBox选中的用户名
    userName = CStr(Me.Hengelaar.Value)
    
    ' 检查是否选择了用户
    If userName = "" Then
        MsgBox "请先选择一个用户！", vbExclamation, "提示"
        Exit Sub
    End If
    
    ' 查找用户名对应的行号
    On Error Resume Next
    matchRow = Application.Match(userName, targetSheet.Range("A:A"), 0)
    On Error GoTo 0
    
    ' 判断是否找到匹配项
    If IsError(matchRow) Then
        MsgBox "未找到用户 '" & userName & "' 的记录！", vbCritical, "错误"
        Exit Sub
    End If
    
    ' 写入修改后的日期到第10列（J列）
    targetSheet.Cells(matchRow, 10).Value = Me.Nuwepermitdatum.Value
    
    ' 提示更新成功
    MsgBox "用户 '" & userName & "' 的许可证到期日期已成功更新！", vbInformation, "更新完成"
End Sub

整合后的完整UserForm代码 #

把上面的代码替换原有的CmdChangedate_Click空事件即可，完整代码如下：

Private Sub CmdChangedate_Click()
    Dim userName As String
    Dim matchRow As Variant
    Dim targetSheet As Worksheet
    
    ' 设置目标工作表
    Set targetSheet = ThisWorkbook.Worksheets("Lede Lys")
    ' 获取ComboBox选中的用户名
    userName = CStr(Me.Hengelaar.Value)
    
    ' 检查是否选择了用户
    If userName = "" Then
        MsgBox "请先选择一个用户！", vbExclamation, "提示"
        Exit Sub
    End If
    
    ' 查找用户名对应的行号
    On Error Resume Next
    matchRow = Application.Match(userName, targetSheet.Range("A:A"), 0)
    On Error GoTo 0
    
    ' 判断是否找到匹配项
    If IsError(matchRow) Then
        MsgBox "未找到用户 '" & userName & "' 的记录！", vbCritical, "错误"
        Exit Sub
    End If
    
    ' 写入修改后的日期到第10列（J列）
    targetSheet.Cells(matchRow, 10).Value = Me.Nuwepermitdatum.Value
    
    ' 提示更新成功
    MsgBox "用户 '" & userName & "' 的许可证到期日期已成功更新！", vbInformation, "更新完成"
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

'This is where the name is selected from a combobox and the date is located
Private Sub Hengelaar_Change()
    With Me
        On Error Resume Next
        .Nuwepermitdatum = Application.WorksheetFunction.VLookup(CStr(Me.Hengelaar), Worksheets("Lede Lys").Range("A:J"), 10, 0)
        On Error GoTo 0
    End With
End Sub

Private Sub Nuwepermitdatum_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub

Private Sub UserForm_Click()
End Sub

Private Sub UserForm_Initialize()
    Dim lastrow As Integer
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Me.Nuwepermitdatum.Value = Date
    Hengelaar.List = Worksheets("Lede Lys").Range("a3:a" & lastrow).Value
End Sub

额外说明 #

• 代码中使用ThisWorkbook.Worksheets("Lede Lys")确保指向当前工作簿的目标工作表，避免因激活其他工作簿导致错误
• 增加了用户未选择用户名的判断，提升交互体验
• 错误处理能有效捕获未找到用户的情况，避免程序崩溃
• 更新完成后会弹出提示框，确认操作结果

内容的提问来源于stack exchange，提问作者Hugo Krynauw