如何更新 Excel 列表中的事件

如何更新 Excel 列表中的事件

我正在尝试构建一个工具跟踪应用程序,用户可以在其中按所需数量签入/签出工具。到目前为止,我已经编写了工具签入的代码,其中包含名称、日期、工具、数量、工作和条件。无论输入什么,都会用此信息自动填充库存表上的下一个空行。

现在我想创建一个包含相同信息的结账表,但我希望它从库存中减去数量,并且如果通过数据验证当前可用数量不足,则不允许用户结账。

我的第一个尝试是使用计数功能来计算列表中工具出现的次数。但是,我遇到的问题是工具名称的出现次数与实际数量没有直接关系。这是因为用户可以输入各种数量。

我想根据条目中的所有原始数据对库存中的当前工具数量进行单独计数。如能得到任何帮助,我将不胜感激,我很乐意回答任何澄清问题。谢谢!

这是我的全部代码:

Option Explicit

Function ValidateForm() As Boolean

    txtName.BackColor = vbWhite
    txtDate.BackColor = vbWhite
    cmbTool.BackColor = vbWhite
    txtQuantity.BackColor = vbWhite
    cmbJob.BackColor = vbWhite
    cmbCondition.BackColor = vbWhite
    
    ValidateForm = True
    
    If Trim(txtName.Value) = "" Then
    
        MsgBox "Name can't be left blank.", vbOKOnly + vbInformation, "Name"
        txtName.BackColor = vbRed
        txtName.Activate
        ValidateForm = False
    ElseIf Trim(txtDate.Value) = "" Then
        
        MsgBox "Date can't be left blank.", vbOKOnly + vbInformation, "Date"
        txtDate.BackColor = vbRed
        txtDate.Activate
        ValidateForm = False
        
    ElseIf Trim(txtQuantity.Value) = "" Then
        
        MsgBox "Quantity can't be left blank.", vbOKOnly + vbInformation, "Quantity"
        txtQuantity.BackColor = vbRed
        txtQuantity.Activate
        ValidateForm = False
    End If
        
    
End Function
Function Reset()

    Application.ScreenUpdating = False
    
    txtName.Value = ""
    txtName.BackColor = vbWhite
    
    txtDate.Value = ""
    txtDate.BackColor = vbWhite
    
    cmbTool.Text = ""
    cmbTool.BackColor = vbWhite
    
    txtQuantity.Value = ""
    txtQuantity.BackColor = vbWhite
    
    cmbJob.Text = ""
    cmbJob.BackColor = vbWhite
    
    cmbCondition.Text = ""
    cmbCondition.BackColor = vbWhite
    
    Application.ScreenUpdating = True
    
    
End Function
Private Sub cmbReset_Click()
    
    Dim i As Integer
    
    i = MsgBox("Do you want to reset this form?", vbQuestion + vbYesNo + vbDefaultButton2, "Form Reset")
    
    If i = vbYes Then
        
        Call Reset
        
    End If
    
End Sub
Private Sub Save_Click()

    Application.ScreenUpdating = False
    
    Dim iRow As Long
    
    iRow = Sheets("Inventory").Range("A1048576").End(xlUp).Row + 1
    
    If ValidateForm = True Then
        
        With ThisWorkbook.Sheets("Inventory")
        
            .Range("A" & iRow).Value = iRow - 1
            .Range("B" & iRow).Value = txtName.Value
            .Range("C" & iRow).Value = txtDate.Value
            .Range("D" & iRow).Value = cmbTool.Text
            .Range("E" & iRow).Value = txtQuantity.Value
            .Range("F" & iRow).Value = cmbJob.Text
            .Range("G" & iRow).Value = cmbCondition.Text
            
        End With
        Call Reset
    Else
        Application.ScreenUpdating = True
        Exit Sub
    End If
        
        Application.ScreenUpdating = True
            
End Sub

答案1

您可以使用WorksheetFunction.SumIf(testedrange,criteria,sumrange)

如果 D 列是工具的名称,则测试范围是 D 列,标准是 cmbTool.Text,并且萨姆兰格是 E 列。猜测第 1 行是表格的标题,则公式为:WorksheetFunction.SumIf(.Range("D2:D") & CStr(iRow),cmbTool.Text,.Range("E2:E" & CStr(iRow))

不过,我强烈建议您“将列表格式化为表格”。这将大大简化您的编码和工作表管理。默认表格名称为“Table1”,但您可以在Excel 表格设计功能区在链接图像的最左侧(在图像中它仍然是“Table1”)。假设您给它起一个像“CheckOuts”这样的名称,并且您的列标题是(A 到 G)、“EntryNbr”、“UserName”、“Date”、“Tool”、“Qty”、“Job”和“Condition”。

您的 Save_Click() 代码可能是

Private Sub Save_Click()
Application.ScreenUpdating=False
With ThisWorkbook.Sheets("Inventory").ListObjects("CheckOuts").ListRows.Add
    .Range(1,1).Value = .Range.Row-1
    .Range(1,2).Value = txtName.Value
    .Range(1,3).Value = txtDate.Value
    .Range(1,4).Value = cmbTool.Text
    .Range(1,5).Value = txtQuantity.Value
    .Range(1,6).Value = cmbJob.Text
    .Range(1,7).Value = cmbCondition.Text
End With
Call Reset
Application.ScreenUpdating=True
End Sub

您不需要跟踪您的iRow变量,因为添加的 ListRow 始终正好是 1 行,并且您的.Range(1,X)指向该 ListRow 中的唯一行。

您的验证可以使用以下方法减去工具的当前“签出”数量 WorkSheetFunction.SumIf([CheckOuts[Tool]],cmbTool.Text,[CheckOuts[Qty]])

[CheckOuts[Tool]]是为该函数提供信息的“工具”列中所有数据单元的“结构化引用”。同样,[CheckOuts[Qty]]是签出数量的结构化引用。然后,该函数将工具与 cmbTool.Text 匹配的所有行的数量值相加。将其从总可用值中减去(您的代码没有给出您在哪里/如何跟踪每个工具的总数的指示),如果 txtQuantity.Value 超过差额,您可以拒绝该请求。

Private Sub txtQuantity_AfterUpdate()
    Dim lAvailable as Long
    
    If txtQuantity.value<>"" Then 
        lAvailable = {Total # Tools} _
            - WorkSheetFunction.SumIf( _
                [CheckOuts[Tool]] _
                , cmbTool.Text _
                , [CheckOuts[Qty]])
        If  lAvailable < txtQuantity.Value Then
            MsgBox "Choose " & lAvailable & " or Fewer", vbOKOnly+vbCritical,"Too Many Requested"
            'Turn off events to prevent looping the Change event
            Application.EnableEvents=False
            'Save the user some typing
            txtQuantity.Value = lAvailable
            'Turn events back on
            Application.EnableEvents=True
        End If
    End If
    'See the following text explanation for this line in the sub
    Save.Enabled=(txtName.Value<>"" and txtDate.Value<>"" and txtQuantity.Value<>"")

End Sub

假设你在另一个名为“总计”的表中跟踪不同的工具总数,其中第一列(工具)中显示工具名称,第二列(数量)中显示总数量...那么{工具总数}值可以通过以下方式计算WorksheetFunction.SumIf([Totals[Tool]],cmbTool.Text,[Totals[Qty]])

如果您确实想使其简单并且您有一个数量输入框标签(,添加:

Private Sub cmbTool_AfterUpdate()
{label name}.Caption = "Quantity"
If cmbTool.Text<>"" Then
    {label name}.Caption = {label name}.Caption _
        & " (" _
        & WorksheetFunction.SumIf([Totals[Tool]],cmbTool.Text,[Totals[Qty]]) _
        - WorkSheetFunction.SumIf([CheckOuts[Tool]],cmbTool.Text,[CheckOuts[Qty]]) _
         & "maximum)"
End If
End Sub

最后,您可以添加:

Private Sub *control*_AfterUpdate()
    Save.Enabled=(txtName.Value<>"" and txtDate.Value<>"" and txtQuantity.Value<>"")
End Sub

在哪里控制是另外两个表单对象,txtName 和 txtDate(那么,对于这三个对象,你都会有一个子对象,但是它们的名称会代替控制)。然后,直到所有三个字段都有值,用户才能单击“保存”按钮。然后,您可以消除验证功能。

你还需要

Private Sub UserForm_Activate()
    Save.Enabled=False
End Sub

这样“保存”按钮就开始被禁用了。

再次,将列表“格式化为表格”大大简化了您的编码,因此您不必尝试跟踪表格中有多少行!

当然,所有代码都需要在用户窗体的代码页中(您提供的代码中的子名称看起来是这样的)

相关内容