Excel 将VBA用户表单中的数据保存到两张图纸中
我试图将用户表单中输入的数据保存到不同的工作表中 我目前遇到的问题是,其中一个工作表VBA必须查找它应该添加的特定行,但另一个工作表将是插入数据的历史记录,因此它需要在下一个空闲行上插入数据 我有一个代码,用于查找并插入第一页:Excel 将VBA用户表单中的数据保存到两张图纸中,excel,vba,userform,Excel,Vba,Userform,我试图将用户表单中输入的数据保存到不同的工作表中 我目前遇到的问题是,其中一个工作表VBA必须查找它应该添加的特定行,但另一个工作表将是插入数据的历史记录,因此它需要在下一个空闲行上插入数据 我有一个代码,用于查找并插入第一页: Private Sub pSave() Dim rw As Integer Dim ws As Worksheet Set ws = Worksheets("Hardware") 'Takting the inserted values from t
Private Sub pSave()
Dim rw As Integer
Dim ws As Worksheet
Set ws = Worksheets("Hardware")
'Takting the inserted values from the userform and inserting them into the spreadsheet
totRows = Worksheets("Hardware").Range("A4").CurrentRegion.Rows.Count
For i = 2 To totRows
If Trim(Worksheets("Hardware").Cells(i, 1)) = Trim(ComboBox_PCNameChoose.Value) Then
'Inserting them into the Hardware sheet (The main sheet)
Worksheets("Hardware").Cells(i, 12).Value = TextBox_Name.Text
Worksheets("Hardware").Cells(i, 13).Value = TextBox_Email.Text
Worksheets("Hardware").Cells(i, 14).Value = TextBox_PhoneNumber.Text
Worksheets("Hardware").Cells(i, 15).Value = DTPicker_Borrow.Value
Worksheets("Hardware").Cells(i, 16).Value = DTPicker_Return.Value
Exit For
End If
Next i
我知道这在另一个用户表单中可以将数据插入到下一个空闲行中,但我不知道如何在同时保存在两个工作表中时使其工作
Dim rw As Integer
Dim ws2 As Worksheet
Set ws2 = Worksheets("Rental_History")
If rw = ws2.Cells.Find(What:="*", Searchorder:=xlRows, SearchDirection:=Previous, LookIn:=xlValues).Row + 1 Then
ws2.Cells(rw, 10).Value = TextBox_Name.Text
ws2.Cells(rw, 11).Value = TextBox_Email.Text
ws2.Cells(rw, 12).Value = TextBox_PhoneNumber.Text
ws2.Cells(rw, 13).Value = DTPicker_Borrow.Value
ws2.Cells(rw, 14).Value = DTPicker_Return.Value
End If
首先,感谢您的时间和帮助!:
致意
-Kira我相信下面的方法会达到您的预期效果,而不是使用For循环来查找要在其中添加第一位数据的行。find方法会更快,因为这会更快,而不是在找到匹配的行之前循环每行,find方法会快速跳转到匹配的行 另外,需要注意的是,我将rw的声明从Integer更改为Long,因为Excel中的单元格数量超过了整型变量的处理能力:
Private Sub pSave()
Dim rw As Long
Dim ws As Worksheet: Set ws = Worksheets("Hardware")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Rental_History")
Dim foundval As Range
'Taking the inserted values from the userform and inserting them into the spreadsheet
Set foundval = ws.Range("A:A").Find(What:=Trim(ComboBox_PCNameChoose.Value)) 'find the value that matches
If Not foundval Is Nothing Then 'if found, use that row to insert data
'Inserting them into the Hardware sheet (The main sheet)
ws.Cells(foundval.Row, 12).Value = TextBox_Name.Text
ws.Cells(foundval.Row, 13).Value = TextBox_Email.Text
ws.Cells(foundval.Row, 14).Value = TextBox_PhoneNumber.Text
ws.Cells(foundval.Row, 15).Value = DTPicker_Borrow.Value
ws.Cells(foundval.Row, 16).Value = DTPicker_Return.Value
End If
rw = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
'get the next free row
ws2.Cells(rw, 10).Value = TextBox_Name.Text
ws2.Cells(rw, 11).Value = TextBox_Email.Text
ws2.Cells(rw, 12).Value = TextBox_PhoneNumber.Text
ws2.Cells(rw, 13).Value = DTPicker_Borrow.Value
ws2.Cells(rw, 14).Value = DTPicker_Return.Value
End Sub
运行此代码时会发生什么情况?在代码的第二部分中放置一个断点并检查rw,它包含什么?您声明了rw1但从未使用过它,当excel中的行数超过整数所能处理的行数时,您将其声明为整数。。。此外,使用For循环插入数据效率低下,因为实际符合条件的行可能是最后一行,因此代码将检查每一行,直到它到达那里为止。。。除此之外,这也会起作用你说得对@Xabier,我错了。我只是在自己的Excel运行时快速回答:rw1在这里没有用`谢谢你的回复Cyril!:任何时候@Kira Jensen都希望它能帮助一个比特完美地工作,谢谢你的建议,我在开始下一个项目时会记住这一点:非常感谢Xabier:@Kira很高兴我能帮上忙…:不过,我发现了一个问题,我无法为组合框设置行源,这是通过在“工作表公式->创建自”部分中创建名称来实现的,这里我通常输入以下代码:=OFFSETHardware!裁判!;0;0;COUNTAHardware$A:$A;1但当我这样做时,用户表单不会接受名称PC_name作为行源?@KiraJensen你确定你的公式=偏移量。。。是正确的,因为REF可能不在那里?它应该是类似于=非道德软件$1美元,0美元,0美元,COUNTAHardware$A:$A,COUNTA$1:$1我现在用起来有问题吗?当我按下按钮时,它不会将数据只发送到ws2?它好像没有正确读取代码?有什么线索可以解释为什么会这样吗
Dim rw As Integer
Dim ws As Worksheet
Set ws = Worksheets("Hardware")
Dim rw1 As Integer
Dim ws2 As Worksheet
Set ws2 = Worksheets("Rental_History")
'Takting the inserted values from the userform and inserting them into the spreadsheet
totRows = Worksheets("Hardware").Range("A4").CurrentRegion.Rows.Count
For i = 2 To totRows
If Trim(Worksheets("Hardware").Cells(i, 1)) = Trim(ComboBox_PCNameChoose.Value) Then
'Inserting them into the Hardware sheet (The main sheet)
rw = ws2.Cells.Find(What:="*", Searchorder:=xlRows, SearchDirection:=Previous, LookIn:=xlValues).Row + 1 'updates rw as it changes at each loop
ws.Cells(i, 12).Value = TextBox_Name.Text
ws2.Cells(rw, 10).Value = ws.Cells(i, 12).Value
ws.Cells(i, 13).Value = TextBox_Email.Text
ws2.Cells(rw, 11).Value = ws.Cells(i, 13).Value
ws.Cells(i, 14).Value = TextBox_PhoneNumber.Text
ws2.Cells(rw, 12).Value = ws.Cells(i, 14).Value
ws.Cells(i, 15).Value = DTPicker_Borrow.Value
ws2.Cells(rw, 13).Value = ws.Cells(i, 15).Value
ws.Cells(i, 16).Value = DTPicker_Return.Value
ws2.Cells(rw, 14).Value = ws.Cells(i, 16).Value
End If
Next i