Excel/VBA 摘要表 - 覆盖数据

Question

首先感谢您之前的帮助!你让我学到了更多，并且仍然每天都在学习更好地编码:)
在之前的文章中，我写过关于使用用户表单进行某些输入的内容。然后它在工作簿的所有工作表中搜索人员姓名并按指定写入数据。在我的工作簿中，我想专门用一张纸来总结所有其他纸。
现在这里是发生错误的地方。数据记录在摘要表上，但是当我选择另一个名称时，第一行 (lRow, 3) 被重新写入。
我认为我的错误发生在 lastrow 语句上。我已经尝试使用 .Range("C"...) 版本来查找最后使用的行。现在它还找到最后使用的行，但也以某种方式用所选名称以外的值覆盖第一行

Dim lRow As Long
Dim Ws As Worksheet
Dim Naam As String
Dim xTo As String
Dim xBCC As String

With Me.ComboBox1
    i = .ListIndex
    If i < 0 Then
        MsgBox "Er is niemand geselecteerd.", vbExclamation
        Exit Sub
    End If
    xTo = .List(i, 1)
    xBCC = .List(i, 2)
    Naam = .List(i, 3)

End With

Set Ws = Worksheets(ComboBox1.Value)

lRow = Ws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row

With Ws

    .Cells(lRow, 3).Value = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
        
    If chk1.Value Then .Cells(lRow, 5).Value = 1
        If chk1.Value = False Then .Cells(lRow, 5).Value = 0
        
    If chk2.Value Then .Cells(lRow, 6).Value = 1
        If chk2.Value = False Then .Cells(lRow, 6).Value = 0
        
    If chk3.Value Then .Cells(lRow, 7).Value = 1
        If chk3.Value = False Then .Cells(lRow, 7).Value = 0
        
    If chk4.Value Then .Cells(lRow, 8).Value = 1
        If chk4.Value = False Then .Cells(lRow, 8).Value = 0
        
    If chk5.Value Then .Cells(lRow, 9).Value = 1
        If chk5.Value = False Then .Cells(lRow, 9).Value = 0

    If chk6.Value Then .Cells(lRow, 10).Value = 1
        If chk6.Value = False Then .Cells(lRow, 10).Value = 0

    If chk7.Value Then .Cells(lRow, 11).Value = 1
        If chk7.Value = False Then .Cells(lRow, 11).Value = 0

    If chk8.Value Then .Cells(lRow, 12).Value = 1
        If chk8.Value = False Then .Cells(lRow, 12).Value = 0

    If chk9.Value Then .Cells(lRow, 13).Value = 1
        If chk9.Value = False Then .Cells(lRow, 13).Value = 0

    If 10.Value Then .Cells(lRow, 14).Value = 1
        If 10.Value = False Then .Cells(lRow, 14).Value = 0

    If chk11.Value Then .Cells(lRow, 15).Value = 1
        If chk11.Value = False Then .Cells(lRow, 15).Value = 0

    If chk12.Value Then .Cells(lRow, 16).Value = 1
        If chk12.Value = False Then .Cells(lRow, 16).Value = 0

    If chk13.Value Then .Cells(lRow, 17).Value = 1
        If chk13.Value = False Then .Cells(lRow, 17).Value = 0

End With

Set Ws = Worksheets("Team totaal")

    With Ws

    .Cells(lRow, 3).Value = Naam
    .Cells(lRow, 4).Value = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")

    If chk1.Value Then .Cells(lRow, 6).Value = 1
        If chk1.Value = False Then .Cells(lRow, 6).Value = 0

    If chk2.Value Then .Cells(lRow, 7).Value = 1
        If chk2.Value = False Then .Cells(lRow, 7).Value = 0

    If chk3.Value Then .Cells(lRow, 8).Value = 1
        If chk3.Value = False Then .Cells(lRow, 8).Value = 0

    If chk4.Value Then .Cells(lRow, 9).Value = 1
        If chk4.Value = False Then .Cells(lRow, 9).Value = 0

    If chk5.Value Then .Cells(lRow, 10).Value = 1
        If chk5.Value = False Then .Cells(lRow, 10).Value = 0

    If chk6.Value Then .Cells(lRow, 11).Value = 1
        If chk6.Value = False Then .Cells(lRow, 11).Value = 0

    If chk7.Value Then .Cells(lRow, 12).Value = 1
        If chk7.Value = False Then .Cells(lRow, 12).Value = 0

    If chk8.Value Then .Cells(lRow, 13).Value = 1
        If chk8.Value = False Then .Cells(lRow, 13).Value = 0

    If chk9.Value Then .Cells(lRow, 14).Value = 1
        If chk9.Value = False Then .Cells(lRow, 14).Value = 0

    If chk10.Value Then .Cells(lRow, 15).Value = 1
        If chk10.Value = False Then .Cells(lRow, 15).Value = 0

    If chk11.Value Then .Cells(lRow, 16).Value = 1
        If chk11.Value = False Then .Cells(lRow, 16).Value = 0

    If chk12.Value Then .Cells(lRow, 17).Value = 1
        If chk12.Value = False Then .Cells(lRow, 17).Value = 0

    If chk13.Value Then .Cells(lRow, 18).Value = 1
        If chk13.Value = False Then .Cells(lRow, 18).Value = 0
    
    End With

也许这不是设置摘要表的正确方法，有人有更有效的方法来做到这一点。欢迎任何帮助

Answer 1

用代码解决问题的最佳方法是将其分解为非常简单的函数和子例程。

这是我的思考过程。
我们可能会在许多宏中提到“团队总数”工作表。 Ws 没有意义。我会将工作表的代码名称更改为 wsTeamTotaal .但这也有效:

Function wsTeamTotaal() As Worksheet
    Set wsTeamTotaal = ThisWorkbook.Worksheets("Team totaal")
End Function

接下来我知道我需要定位 wsTeamTotaal 中的下一个可用行.这应该这样做。

Function TeamTotalNewRow() As Range
    With wsTeamTotaal
        Set TeamTotalNewRow = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
    End With
End Function

我要写一个 60 行的脚本来测试它吗？一定不行!!此函数选择新行中的第一个单元格。

Sub GotoTeamTotalNewRow()
    Application.Goto TeamTotalNewRow
End Sub

好的，现在我编写一个脚本来收集所有信息并附加行，对吗？错误的!使用 ParamArray 编写一个接受可变数量参数的函数可以简化该过程。现在我可以在不进行任何重大修改的情况下附加 1 个 60+ 值。

Sub AppendTeamTotaalRow(ParamArray Args() As Variant)
    With TeamTotalNewRow
        .Resize(1, UBound(Args) + 1).Value = Args
    End With
End Sub

所以要花一个小时写一个用户表单，收集数据，然后测试 append 方法。当然不是。什么更容易测试，一个包含完整功能和控件的用户表单或一个简单的子例程？

Sub TestAddNewTeamTotalRow()
    Dim TimeStamp As String
    TimeStamp = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
    AppendTeamTotaalRow TimeStamp, True, False, True, False
End Sub

请注意，我用最简单的术语打破了这个问题，并分别解决了每个问题。我们现在有 2 个函数，一个子例程和两个测试。每个例程执行一个任务，没有一个例程超过 5 行。简化，简化，简化，就这么简单。
完整代码

Function TeamTotalNewRow() As Range
    With wsTeamTotaal
        Set TeamTotalNewRow = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
    End With
End Function

Function wsTeamTotaal() As Worksheet
    Set wsTeamTotaal = ThisWorkbook.Worksheets("Team totaal")
End Function

Sub GotoTeamTotalNewRow()
    Application.Goto TeamTotalNewRow
End Sub

Sub AppendTeamTotaalRow(ParamArray Args() As Variant)
    With TeamTotalNewRow
        TeamTotalNewRow.Resize(1, UBound(Args) + 1).Value = Args
    End With
End Sub

Sub TestAddNewTeamTotalRow()
    Dim TimeStamp As String
    TimeStamp = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
    AppendTeamTotaalRow TimeStamp, True, False, True, False
End Sub