将 VBA 用户表单中的数据保存到两张表中
Save data from VBA userform into to two sheets
我正在尝试将在用户表单中输入的数据保存到不同的 sheet 中。
我目前遇到的问题是,sheet 中的一个 VBA 必须查找要添加它的特定行,但另一个 sheet将是插入数据的历史记录,因此需要在下一个空闲行插入数据。
我有这段代码可用于查找并插入第一个 sheet:
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
我知道这在另一个用户表单中有效,用于将数据插入下一个空闲行,但我不知道如何在同时保存两个 sheet 时让它工作
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
预先感谢您的宝贵时间和帮助! :)
最好的问候
- 基拉
我相信以下将实现您的预期,而不是使用 For 循环来查找要添加第一位数据的行我使用了 .Find 方法,因为这样会更快,而不是遍历每一行直到找到匹配项,find 方法将快速跳转到匹配的行。
同样重要的是要注意,我将 rw 的声明从 Integer 更改为 Long,因为 Excel 中的单元格比 Integer 变量可以处理的多:
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
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
我正在尝试将在用户表单中输入的数据保存到不同的 sheet 中。
我目前遇到的问题是,sheet 中的一个 VBA 必须查找要添加它的特定行,但另一个 sheet将是插入数据的历史记录,因此需要在下一个空闲行插入数据。
我有这段代码可用于查找并插入第一个 sheet:
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
我知道这在另一个用户表单中有效,用于将数据插入下一个空闲行,但我不知道如何在同时保存两个 sheet 时让它工作
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
预先感谢您的宝贵时间和帮助! :)
最好的问候 - 基拉
我相信以下将实现您的预期,而不是使用 For 循环来查找要添加第一位数据的行我使用了 .Find 方法,因为这样会更快,而不是遍历每一行直到找到匹配项,find 方法将快速跳转到匹配的行。
同样重要的是要注意,我将 rw 的声明从 Integer 更改为 Long,因为 Excel 中的单元格比 Integer 变量可以处理的多:
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
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