时间戳

首页 > 解决方案 > 将表单响应从一张表更新到另一张表

excel - 将表单响应从一张表更新到另一张表

问题描述

我在 Excel 中创建了一个数据输入表单。

我希望将该输入存储在另一张表（表格格式）中。

我在网上找到并修改的代码：

Function ValidateForm() As Boolean
    SellerSKU.BackColor = vbWhite
    Description.BackColor = vbWhite

    ValidateForm = True

    If Trim(SellerSKU.Value) = "" Then
        MsgBox "SKU can't be left blank.", vbOKOnly + vbInformation, "SKU"
        SellerSKU.BackColor = vbRed
        SellerSKU.Activate
        ValidateForm = False

    ElseIf Trim(Description.Value) = "" Then
        MsgBox "Description can't be left blank.", vbOKOnly + vbInformation, "Description"
        Description.BackColor = vbRed
        Description.Activate
        ValidateForm = False
    End If

End Function


Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    SellerSKU.Value = ""
    SellerSKU.BackColor = vbWhite

    Description.Value = ""
    Description.BackColor = vbWhite

End Sub

Private Sub CommandButton2_Click()

    Application.ScreenUpdating = False

    Dim iRow As Long

    iRow = Sheets("Reference Sheet (Order Hist)").Range("A1048576").End(xlUp).Row + 1

    If ValidateForm = True Then

        With ThisWorkbook.Sheets("Reference Sheet (Order Hist)")
            .Range("A" & iRow).Value = SellerSKU.Value
            .Range("C" & iRow).Value = Description.Value
        End With
        Call Reset
    Else
        Application.ScreenUpdating = False
        Exit Sub
    End If
    Application.ScreenUpdating = True

End Sub

当我在数据输入表单上按“Enter”时，另一张表上的表格没有更新。

每次成功输入时是否可以清除表格？

标签： excelvba

解决方案

这对我有用。重新组织并删除了一些重复...

Private Sub CommandButton2_Click()

    Dim iRow As Long, valErrors As String
    
    valErrors = ValidationErrors() 'checks the form
    
    If Len(valErrors) = 0 Then
        'no errors - add the data
        With ThisWorkbook.Worksheets("Reference Sheet (Order Hist)")
            iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & iRow).Value = SellerSKU.Value
            .Range("C" & iRow).Value = Description.Value
        End With
        ResetForm  'Call keyword is deprecated...
    Else
        MsgBox "One or more errors in form entries:" & vbLf & vbLf & valErrors, _
                vbOKOnly + vbExclamation, "Check form data"
    End If
   
End Sub

'check the form and return a listing of any errors
Function ValidationErrors() As String
    Dim msg As String
    
    CheckNonBlank SellerSKU, "SKU can't be left blank.", msg
    CheckNonBlank Description, "Description can't be left blank.", msg
    ValidationErrors = msg
End Function

'utility sub - check if a control has text, flag as error if missing,
'   and add some text to the overall validation message
Sub CheckNonBlank(cntrl As Object, msgErr As String, ByRef msg As String)
    Dim isErr As Boolean
    isErr = Len(Trim(cntrl.Value)) = 0 'true if no content
    ErrorFlag cntrl, isErr
    If isErr And Len(msgErr) > 0 Then
        msg = msg & IIf(Len(msg) > 0, vbLf, "") & msgErr 'append this error
    End If
End Sub

Private Sub CommandButton1_Click()
    ResetForm
End Sub

'clear textboxes and any error flags
Sub ResetForm()
    SellerSKU.Value = ""
    ErrorFlag SellerSKU, False
    Description.Value = ""
    ErrorFlag Description, False
End Sub

'flag a control as having a problem (pass False to second parameter to clear flag)
Sub ErrorFlag(cntrl As Object, Optional HasError As Boolean = True)
    cntrl.BackColor = IIf(HasError, vbRed, vbWhite)
End Sub

推荐阅读