首先感謝您之前的幫助！你讓我學到了更多，并且仍然每天都在學習更好地編碼:)
在之前的文章中，我寫過關于使用用戶表單進行某些輸入的內容。然后它在作業簿的所有作業表中搜索人員姓名并按指定寫入資料。在我的作業簿中，我想專門用一張紙來總結所有其他紙。
現在這里是發生錯誤的地方。資料記錄在摘要表上，但是當我選擇另一個名稱時，第一行 (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
也許這不是設定摘要表的正確方法，有人有更有效的方法來做到這一點。歡迎任何幫助
uj5u.com熱心網友回復：
用代碼解決問題的最佳方法是將其分解為非常簡單的函式和子例程。
這是我的思考程序。
我們可能會在許多宏中提到“團隊總數”作業表。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
TeamTotalNewRow.Resize(1, UBound(Args) 1).Value = Args
End With
End Sub
So time to spend a hour writing a userform, gather the data and then testing the append method. Of course not. What's easier to test, a userform packed full of functionality and controls or one simple sub routine?
Sub TestAddNewTeamTotalRow()
Dim TimeStamp As String
TimeStamp = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
AppendTeamTotaalRow TimeStamp, True, False, True, False
End Sub
Notice that I broke this problem do to it's simplest terms and solved each problem separately. We now have 2 functions, a sub routine and two tests. Each routine performs a single task and no routine has more than 5 lines. Simplify, simplify, simplify, it's that simple.
Complete Code
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/434849.html