如何使用VBA更新用戶表單中的Excel工作表數據

Question

您想知道我如何從Excel工作表中檢索數據並在用戶表單中對其進行更新。

在圖片上，您可以看到用戶窗體的外觀。 我想做的是制作另一個用戶表單，該表單可以在工作表中搜索特定參考並更新該特定行的某些單元格。

這是我現在將數據插入表中的代碼。

Private Sub cmdClear_Click()
' Clear the form
 For Each ctl In Me.Controls
 If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
 ctl.Value = ""
 ElseIf TypeName(ctl) = "CheckBox" Then
 ctl.Value = False
 End If
 Next ctl
End Sub

Private Sub cmdSend_Click()
    Dim RowCount As Long
    Dim ctl As Control
' Check user input

    If Me.combTechnieker.Value = "" Then
        MsgBox "Dag vreemdeling! Welke van de 4 Mongolen ben je?", vbExclamation, "RMA invoer"
        Me.combTechnieker.SetFocus
        Exit Sub
    End If

    If Me.txtPcwRef.Value = "" Then
        MsgBox "Vul onze referentie in!", vbExclamation, "RMA invoer"
        Me.txtPcwRef.SetFocus
        Exit Sub
    End If

    If Me.txtKlant.Value = "" Then
        MsgBox "Vul de naam van de klant in!", vbExclamation, "RMA invoer"
        Me.txtKlant.SetFocus
        Exit Sub
    End If

    If Me.txtMerk.Value = "" Then
        MsgBox "Vul het merk in!", vbExclamation, "RMA invoer"
        Me.txtMerk.SetFocus
        Exit Sub
    End If

    If Me.txtMerkRef.Value = "" Then
        MsgBox "Vul de referentie van de fabrikant in!", vbExclamation, "RMA invoer"
        Me.txtMerkRef.SetFocus
        Exit Sub
    End If

    If Me.txtProduct.Value = "" Then
        MsgBox "Vul het product in!", vbExclamation, "RMA invoer"
        Me.txtProduct.SetFocus
        Exit Sub
    End If

    If Me.txtSerienummer.Value = "" Then
        MsgBox "Vul het serienummer in!", vbExclamation, "RMA invoer"
        Me.txtSerienummer.SetFocus
        Exit Sub
    End If

    If Me.txtProbleem.Value = "" Then
        MsgBox "Vul de probleem omschrijving in!", vbExclamation, "RMA invoer"
        Me.txtProbleem.SetFocus
        Exit Sub
    End If

    If Me.txtOnderdelen.Value = "" Then
        MsgBox "Bent u zeker dat er geen onderdelen achterblijven. Indien ja. Vul N/A in", vbExclamation, "RMA invoer"
        Me.txtOnderdelen.SetFocus
        Exit Sub
    End If

' Write data to worksheet
    RowCount = Worksheets("RMA 2016").Range("A1").CurrentRegion.Rows.Count

    With Worksheets("RMA 2016").Range("A1")
        .Offset(RowCount, 0).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
        .Offset(RowCount, 1).Value = "Open"
        .Offset(RowCount, 3).Value = Me.txtPcwRef.Value
        .Offset(RowCount, 4).Value = Me.txtKlant.Value
        .Offset(RowCount, 5).Value = Me.txtMerk.Value
        .Offset(RowCount, 6).Value = Me.txtMerkRef.Value
        .Offset(RowCount, 7).Value = Me.txtProduct.Value
        .Offset(RowCount, 8).Value = Me.txtSerienummer.Value
        .Offset(RowCount, 9).Value = Me.txtOnderdelen.Value
        .Offset(RowCount, 10).Value = Me.txtProbleem.Value
        .Offset(RowCount, 13).Value = Me.combTechnieker.Value

    If Me.chkGarantie.Value = True Then
     .Offset(RowCount, 2).Value = "Ja"
     Else
    .Offset(RowCount, 2).Value = "Nee"
    End If
    End With
    ' Clear the form
     For Each ctl In Me.Controls
     If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
     ctl.Value = ""
    ElseIf TypeName(ctl) = "CheckBox" Then
    ctl.Value = False
    End If
    Next ctl
End Sub

Private Sub UserForm_Click()

End Sub

Answer 1

我創建了一個小示例來展示加載，保存和刪除記錄的一般機制如何與表單一起使用。 當您嘗試保存不存在的ID的記錄時，它將在表中追加一條新記錄。 這應該非常接近您的要求，並向您展示如何在用戶表單和工作表之間進行數據混排。

Private Sub cmdLoad_Click()

    ' check if provided product ID is not empty
    If Len(Trim(Me.txtId)) = 0 Then
        MsgBox "Enter product ID to load the record."
        Exit Sub
    End If

    ' try to retrieve the product by ID
    Dim rngIdList As Range, rngId As Range
    Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))

    Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
    If rngId Is Nothing Then
        ' product ID is not found
        MsgBox "Product ID " & Me.txtId & " doesn't exist."
        Exit Sub
    Else
        ' product ID is found -- fill out the form
        Me.txtId = rngId.Offset(0, 0)
        Me.txtName = rngId.Offset(0, 1)
        Me.txtNote = rngId.Offset(0, 2)
    End If

End Sub

Private Sub cmdSave_Click()

    ' check if provided product ID is not empty
    If Len(Trim(Me.txtId)) = 0 Then
        MsgBox "Enter product ID to load the record."
        Exit Sub
    End If

    ' try to retrieve the product by ID
    Dim rngIdList As Range, rngId As Range
    Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))

    Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
    If rngId Is Nothing Then
        ' if product ID is not found, append new one to the end of the table
        With rngIdList
            Set rngId = .Offset(.Rows.Count, 0).Resize(1, 1)
        End With
    End If

    ' update excel record
    rngId.Offset(0, 0) = Me.txtId
    rngId.Offset(0, 1) = Me.txtName
    rngId.Offset(0, 2) = Me.txtNote

End Sub

Private Sub cmdDelete_Click()

    ' check if provided product ID is not empty
    If Len(Trim(Me.txtId)) = 0 Then
        MsgBox "Enter product ID to delete the record."
        Exit Sub
    End If

    ' try to retrieve the product by ID
    Dim rngIdList As Range, rngId As Range
    Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))

    Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
    If rngId Is Nothing Then
        ' product ID is not found -- nothing to delete
        MsgBox "Product ID " & Me.txtId & " doesn't exist."
        Exit Sub
    Else
        ' product ID is found -- delete the entire line
        rngId.EntireRow.Delete
    End If

End Sub

Answer 2

這里是一個鏈接，將說明如何執行此操作。

http://www.onlinepclearning.com/edit-and-delete-from-a-userform/

本質上，您需要使用高級過濾器記錄宏，該過濾器可以根據所需條件過濾數據。 然后，這些數據可用於使用動態名稱范圍在用戶表單中提供列表框，在該列表中也將復制過濾的數據。 然后，您可以編寫一些代碼，使其雙擊時可以在用戶窗體中提供空白文本框。 然后，使用記錄的宏，該宏利用excel的“查找”功能，可以找到更新的條目（如果它具有唯一的ID），然后用新值替換舊值。

提供的鏈接將逐步完成此步驟。 您只需要修改以適合您的工作簿即可。

希望這可以幫助！

我所做的項目示例：

'this is my recorded filter

Sub FilterData()
'
' FilterData Macro
'

'
    Sheets("Propert Data").Range("A6:M80").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("Sheet2!Criteria"), CopyToRange:=Range( _
        "Sheet2!Extract"), Unique:=False
End Sub

'This feeds the listbox

Dim ws As Worksheet
'Set Worksheet Variable
Set ws = Sheet2
'Run Filter
FilterLoans 'this is a recorded macro
'Add named range to rowsource
If ws.Range("A5").Value = "" Then
Me.loanlist.RowSource = ""
Else
Me.loanlist.RowSource = "FilterLoans" 'this is a dynamic name range
End If

   'This feeds the empty cells

   Private Sub loanlist_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim i As Integer
On Error Resume Next
i = Me.loanlist.ListIndex
Me.edloannametxt.Value = Me.loanlist.Column(0, i)
Me.edpropnametxt.Value = Me.loanlist.Column(1, i)
Me.edloantypecbx.Value = Me.loanlist.Column(2, i)
Me.edbalancetxt.Value = Me.loanlist.Column(3, i)
Me.edbalancetxt.Value = Format(Val(edbalancetxt.Value), "$#,###")
Me.edpmttxt.Value = Me.loanlist.Column(4, i)
Me.edpmttxt.Value = Format(Val(edpmttxt.Value), "$#,###")
Me.edannualtxt.Value = Me.loanlist.Column(5, i)
Me.edannualtxt.Value = Format(Val(edannualtxt.Value), "$#,###")
Me.edratetxt.Value = Me.loanlist.Column(6, i)
Me.edratetxt.Value = Format(Val(edratetxt.Value), "Percent")
Me.edamtxt.Value = Me.loanlist.Column(7, i)
Me.edbbtcbx.Value = Me.loanlist.Column(8, i)
Me.uidtxt.Value = Me.loanlist.Column(9, i)

End Sub

'this finds and updates that old data

Private Sub updateloancmd_Click()

Dim findvalue As Range
Dim cNum As Integer
Dim DataSH As Worksheet

Application.ScreenUpdating = False
Set DataSH = Sheet10

Set findvalue = DataSH.Range("K:K"). _
Find(What:=Me.uidtxt.Value, LookIn:=xlValues, LookAt:=xlWhole)

findvalue = uidtxt.Value
If findvalue = "" Then
Exit Sub
Else
findvalue.Offset(0, -1) = edbbtcbx.Value
findvalue.Offset(0, -2) = edamtxt.Value
findvalue.Offset(0, -3) = edratetxt.Value
findvalue.Offset(0, -5) = edpmttxt.Value
findvalue.Offset(0, -6) = edbalancetxt.Value
findvalue.Offset(0, -7) = edloantypecbx.Value
findvalue.Offset(0, -8) = edpropnametxt.Value
findvalue.Offset(0, -9) = edloannametxt.Value
End If

End Sub