Excel - 从 excel sheet 中提取数据到用户表单
Excel - Pulling Data from excel sheet to userform
有没有人能够帮助我 VBA 我正在尝试 运行 的代码。
我希望代码从 sheet 中提取数据并将其放入用户窗体中,我想要的数据将取决于三个条件(文本框 1、2 和组合框 11)
如果在sheet1中找不到数据,则搜索sheet2。
下面是我的代码。
Private Sub CommandButton3_Click()
'Search and Display - form
'search for matching data from the textboxes
Dim Criteria As Variant
Criteria = Array(TextBox1.Text, TextBox2.Text, ComboBox11.Text)
lastrow = Worksheets("WFH Data MFB").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("WFH Data MFB").Cells(i, 1, 2, 3).Value = Criteria Then
ComboBox8.Text = Worksheets("WFH data MFB").Cells(i, 4).Value 'signature
ComboBox1.Text = Worksheets("WFH data MFB").Cells(i, 5).Value 'PC Type
TextBox4.Text = Worksheets("WFH data MFB").Cells(i, 6).Value 'Monitor
CheckBox3.Value = Worksheets("WFH data MFB").Cells(i, 7).Value 'Keyboard
CheckBox4.Value = Worksheets("WFH data MFB").Cells(i, 7).Value
CheckBox5.Value = Worksheets("WFH data MFB").Cells(i, 8).Value 'mouse
CheckBox6.Value = Worksheets("WFH data MFB").Cells(i, 8).Value
CheckBox7.Value = Worksheets("WFH data MFB").Cells(i, 9).Value 'Webcam
CheckBox8.Value = Worksheets("WFH data MFB").Cells(i, 9).Value
CheckBox9.Value = Worksheets("WFH data MFB").Cells(i, 10).Value 'Headset
CheckBox10.Value = Worksheets("WFH data MFB").Cells(i, 10).Value
CheckBox11.Value = Worksheets("WFH data MFB").Cells(i, 11).Value 'Speakers
CheckBox12.Value = Worksheets("WFH data MFB").Cells(i, 11).Value
CheckBox13.Value = Worksheets("WFH data MFB").Cells(i, 12).Value 'Laptop risers
CheckBox14.Value = Worksheets("WFH data MFB").Cells(i, 12).Value
TextBox3.Text = Worksheets("WFH data MFB").Cells(i, 12).Value 'other
End If
'if the data isnt in sheet ("MFB") then search sheet ("KPF")
If Worksheets("WFH Data MFB").Cells(i, 1, 2, 3).Value = Criteria.Value = " " Then
If Worksheets("WFH Data KPF").Cells(i, 1, 2, 3).Value = Criteria Then
For A = 2 To lastrow
If Worksheets("WFH Data MFB").Cells(A, 1, 2, 3).Value = Criteria Then
ComboBox8.Text = Worksheets("WFH data KPF").Cells(A, 4).Value 'signature
ComboBox1.Text = Worksheets("WFH data KPF").Cells(A, 5).Value 'PC Type
TextBox4.Text = Worksheets("WFH data KPF").Cells(A, 6).Value 'Monitor
CheckBox3.Value = Worksheets("WFH data KPF").Cells(A, 7).Value 'Keyboard
CheckBox4.Value = Worksheets("WFH data KPF").Cells(A, 7).Value
CheckBox5.Value = Worksheets("WFH data KPF").Cells(A, 8).Value 'mouse
CheckBox6.Value = Worksheets("WFH data KPF").Cells(A, 8).Value
CheckBox7.Value = Worksheets("WFH data KPF").Cells(A, 9).Value 'Webcam
CheckBox8.Value = Worksheets("WFH data KPF").Cells(A, 9).Value
CheckBox9.Value = Worksheets("WFH data KPF").Cells(A, 10).Value 'Headset
CheckBox10.Value = Worksheets("WFH data KPF").Cells(A, 10).Value
CheckBox11.Value = Worksheets("WFH data KPF").Cells(A, 11).Value 'Speakers
CheckBox12.Value = Worksheets("WFH data KPF").Cells(A, 11).Value
CheckBox13.Value = Worksheets("WFH data KPF").Cells(A, 12).Value 'Laptop risers
CheckBox14.Value = Worksheets("WFH data KPF").Cells(A, 12).Value
TextBox3.Text = Worksheets("WFH data KPF").Cells(A, 12).Value 'other
End If
Next
End Sub
这是一个可能的代码:
Private Sub CommandButton3_Click()
'SEARCH AND DISPLAY - FORM
'Search for matching data from the textboxes
'Declarations.
Dim VarCriteria As Variant
Dim WksTarget As Worksheet
Dim WksWorksheet01 As Worksheet
Dim WksWorksheet02 As Worksheet
Dim RngSearch As Range
Dim RngTarget As Range
Dim RngPin As Range
'Setting variables.
VarCriteria = Array(TextBox1.Text, TextBox2.Text, ComboBox11.Text)
Set WksWorksheet01 = Worksheets("WFH Data MFB")
Set WksWorksheet02 = Worksheets("WFH Data KPF")
'Setting WksTarget.
Set WksTarget = WksWorksheet01
'Checkpoint for the second run (with the second worksheet).
CP_Worksheet_Restart:
'Focusing on WksTarget.
With WksTarget
'Setting RngSearch for the area to be searched in the given worksheet (WksTarget).
Set RngSearch = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
'Checking if there are no data that match the criteria.
If Excel.WorksheetFunction.CountIfs(RngSearch, VarCriteria(0), RngSearch.Offset(0, 1), VarCriteria(1), RngSearch.Offset(0, 2), VarCriteria(2)) = 0 Then
'If no match is found, checks if we are focused on WksWorksheet02.
If WksTarget.Name = WksWorksheet02.Name Then
'If we are focusing on WksWorksheet02, the code is sent to CP_No_Match_Found.
GoTo CP_No_Match_Found
Else
'If we are not focusing on WksWorksheet02, WksTarget is reset and the code is sent back to CP_Worksheet_Restart.
Set WksTarget = WksWorksheet02
GoTo CP_Worksheet_Restart
End If
End If
'Setting RngPin as the first cell that matches the first criteria.
Set RngPin = Nothing
Set RngPin = RngSearch.Find(What:=VarCriteria(0), _
After:=RngSearch.Cells(RngSearch.Rows.Count, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'Checking if RngPin has been set.
If Not (RngPin Is Nothing) Then
'Setting RngTarget.
Set RngTarget = RngPin
Else
'If RngPin is still nothing (it could hardly be the case), checks if we are focused on WksWorksheet02.
If WksTarget.Name = WksWorksheet02.Name Then
'If we are focusing on WksWorksheet02, the code is sent to CP_No_Match_Found.
GoTo CP_No_Match_Found
Else
'If we are not focusing on WksWorksheet02, WksTarget is reset and the code is sent back to CP_Worksheet_Restart.
Set WksTarget = WksWorksheet02
GoTo CP_Worksheet_Restart
End If
End If
'Checkpoint for the next targeted range.
CP_Next_Target:
'Checking if RngTarget and the two cells next to it match all 3 criteria.
If RngTarget.Offset(0, 1).Value = VarCriteria(1) And RngTarget.Offset(0, 2).Value = VarCriteria(2) Then
'If a match is found, the data are reported and the macro is terminated
ComboBox8.Text = RngTarget.Offset(0, 3).Value 'signature
ComboBox1.Text = RngTarget.Offset(0, 4).Value 'PC Type
TextBox4.Text = RngTarget.Offset(0, 5).Value 'Monitor
CheckBox3.Value = RngTarget.Offset(0, 6).Value 'Keyboard
CheckBox4.Value = RngTarget.Offset(0, 6).Value
CheckBox5.Value = RngTarget.Offset(0, 7).Value 'mouse
CheckBox6.Value = RngTarget.Offset(0, 7).Value
CheckBox7.Value = RngTarget.Offset(0, 8).Value 'Webcam
CheckBox8.Value = RngTarget.Offset(0, 8).Value
CheckBox9.Value = RngTarget.Offset(0, 9).Value 'Headset
CheckBox10.Value = RngTarget.Offset(0, 9).Value
CheckBox11.Value = RngTarget.Offset(0, 10).Value 'Speakers
CheckBox12.Value = RngTarget.Offset(0, 10).Value
CheckBox13.Value = RngTarget.Offset(0, 11).Value 'Laptop risers
CheckBox14.Value = RngTarget.Offset(0, 11).Value
TextBox3.Text = RngTarget.Offset(0, 11).Value 'other
Exit Sub
Else
'If no match is found, RngTarget is reset to the next cell that matches the first criteria.
Set RngTarget = RngSearch.Find(What:=VarCriteria(0), _
After:=RngTarget, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If RngTarget has been set back to RngPin and so no match has been found (it could hardly be the case), an error message is displayed and the macro si terminated. Otherwise the code is sent back to CP_Next_Target.
If RngTarget.Address = RngPin.Address Then
MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1) & vbCrLf & VarCriteria(2), vbCritical + vbOKOnly, "No match found"
Else
GoTo CP_Next_Target
End If
End If
End With
Exit Sub
CP_No_Match_Found:
'An error message is displayed and the macro si terminated.
MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1) & vbCrLf & VarCriteria(2), vbCritical + vbOKOnly, "No match found"
Exit Sub
End Sub
我无法真正测试它,因为我没有完整的表格。更好的代码也可能。发送反馈。
有没有人能够帮助我 VBA 我正在尝试 运行 的代码。
我希望代码从 sheet 中提取数据并将其放入用户窗体中,我想要的数据将取决于三个条件(文本框 1、2 和组合框 11)
如果在sheet1中找不到数据,则搜索sheet2。
下面是我的代码。
Private Sub CommandButton3_Click()
'Search and Display - form
'search for matching data from the textboxes
Dim Criteria As Variant
Criteria = Array(TextBox1.Text, TextBox2.Text, ComboBox11.Text)
lastrow = Worksheets("WFH Data MFB").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("WFH Data MFB").Cells(i, 1, 2, 3).Value = Criteria Then
ComboBox8.Text = Worksheets("WFH data MFB").Cells(i, 4).Value 'signature
ComboBox1.Text = Worksheets("WFH data MFB").Cells(i, 5).Value 'PC Type
TextBox4.Text = Worksheets("WFH data MFB").Cells(i, 6).Value 'Monitor
CheckBox3.Value = Worksheets("WFH data MFB").Cells(i, 7).Value 'Keyboard
CheckBox4.Value = Worksheets("WFH data MFB").Cells(i, 7).Value
CheckBox5.Value = Worksheets("WFH data MFB").Cells(i, 8).Value 'mouse
CheckBox6.Value = Worksheets("WFH data MFB").Cells(i, 8).Value
CheckBox7.Value = Worksheets("WFH data MFB").Cells(i, 9).Value 'Webcam
CheckBox8.Value = Worksheets("WFH data MFB").Cells(i, 9).Value
CheckBox9.Value = Worksheets("WFH data MFB").Cells(i, 10).Value 'Headset
CheckBox10.Value = Worksheets("WFH data MFB").Cells(i, 10).Value
CheckBox11.Value = Worksheets("WFH data MFB").Cells(i, 11).Value 'Speakers
CheckBox12.Value = Worksheets("WFH data MFB").Cells(i, 11).Value
CheckBox13.Value = Worksheets("WFH data MFB").Cells(i, 12).Value 'Laptop risers
CheckBox14.Value = Worksheets("WFH data MFB").Cells(i, 12).Value
TextBox3.Text = Worksheets("WFH data MFB").Cells(i, 12).Value 'other
End If
'if the data isnt in sheet ("MFB") then search sheet ("KPF")
If Worksheets("WFH Data MFB").Cells(i, 1, 2, 3).Value = Criteria.Value = " " Then
If Worksheets("WFH Data KPF").Cells(i, 1, 2, 3).Value = Criteria Then
For A = 2 To lastrow
If Worksheets("WFH Data MFB").Cells(A, 1, 2, 3).Value = Criteria Then
ComboBox8.Text = Worksheets("WFH data KPF").Cells(A, 4).Value 'signature
ComboBox1.Text = Worksheets("WFH data KPF").Cells(A, 5).Value 'PC Type
TextBox4.Text = Worksheets("WFH data KPF").Cells(A, 6).Value 'Monitor
CheckBox3.Value = Worksheets("WFH data KPF").Cells(A, 7).Value 'Keyboard
CheckBox4.Value = Worksheets("WFH data KPF").Cells(A, 7).Value
CheckBox5.Value = Worksheets("WFH data KPF").Cells(A, 8).Value 'mouse
CheckBox6.Value = Worksheets("WFH data KPF").Cells(A, 8).Value
CheckBox7.Value = Worksheets("WFH data KPF").Cells(A, 9).Value 'Webcam
CheckBox8.Value = Worksheets("WFH data KPF").Cells(A, 9).Value
CheckBox9.Value = Worksheets("WFH data KPF").Cells(A, 10).Value 'Headset
CheckBox10.Value = Worksheets("WFH data KPF").Cells(A, 10).Value
CheckBox11.Value = Worksheets("WFH data KPF").Cells(A, 11).Value 'Speakers
CheckBox12.Value = Worksheets("WFH data KPF").Cells(A, 11).Value
CheckBox13.Value = Worksheets("WFH data KPF").Cells(A, 12).Value 'Laptop risers
CheckBox14.Value = Worksheets("WFH data KPF").Cells(A, 12).Value
TextBox3.Text = Worksheets("WFH data KPF").Cells(A, 12).Value 'other
End If
Next
End Sub
这是一个可能的代码:
Private Sub CommandButton3_Click()
'SEARCH AND DISPLAY - FORM
'Search for matching data from the textboxes
'Declarations.
Dim VarCriteria As Variant
Dim WksTarget As Worksheet
Dim WksWorksheet01 As Worksheet
Dim WksWorksheet02 As Worksheet
Dim RngSearch As Range
Dim RngTarget As Range
Dim RngPin As Range
'Setting variables.
VarCriteria = Array(TextBox1.Text, TextBox2.Text, ComboBox11.Text)
Set WksWorksheet01 = Worksheets("WFH Data MFB")
Set WksWorksheet02 = Worksheets("WFH Data KPF")
'Setting WksTarget.
Set WksTarget = WksWorksheet01
'Checkpoint for the second run (with the second worksheet).
CP_Worksheet_Restart:
'Focusing on WksTarget.
With WksTarget
'Setting RngSearch for the area to be searched in the given worksheet (WksTarget).
Set RngSearch = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
'Checking if there are no data that match the criteria.
If Excel.WorksheetFunction.CountIfs(RngSearch, VarCriteria(0), RngSearch.Offset(0, 1), VarCriteria(1), RngSearch.Offset(0, 2), VarCriteria(2)) = 0 Then
'If no match is found, checks if we are focused on WksWorksheet02.
If WksTarget.Name = WksWorksheet02.Name Then
'If we are focusing on WksWorksheet02, the code is sent to CP_No_Match_Found.
GoTo CP_No_Match_Found
Else
'If we are not focusing on WksWorksheet02, WksTarget is reset and the code is sent back to CP_Worksheet_Restart.
Set WksTarget = WksWorksheet02
GoTo CP_Worksheet_Restart
End If
End If
'Setting RngPin as the first cell that matches the first criteria.
Set RngPin = Nothing
Set RngPin = RngSearch.Find(What:=VarCriteria(0), _
After:=RngSearch.Cells(RngSearch.Rows.Count, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'Checking if RngPin has been set.
If Not (RngPin Is Nothing) Then
'Setting RngTarget.
Set RngTarget = RngPin
Else
'If RngPin is still nothing (it could hardly be the case), checks if we are focused on WksWorksheet02.
If WksTarget.Name = WksWorksheet02.Name Then
'If we are focusing on WksWorksheet02, the code is sent to CP_No_Match_Found.
GoTo CP_No_Match_Found
Else
'If we are not focusing on WksWorksheet02, WksTarget is reset and the code is sent back to CP_Worksheet_Restart.
Set WksTarget = WksWorksheet02
GoTo CP_Worksheet_Restart
End If
End If
'Checkpoint for the next targeted range.
CP_Next_Target:
'Checking if RngTarget and the two cells next to it match all 3 criteria.
If RngTarget.Offset(0, 1).Value = VarCriteria(1) And RngTarget.Offset(0, 2).Value = VarCriteria(2) Then
'If a match is found, the data are reported and the macro is terminated
ComboBox8.Text = RngTarget.Offset(0, 3).Value 'signature
ComboBox1.Text = RngTarget.Offset(0, 4).Value 'PC Type
TextBox4.Text = RngTarget.Offset(0, 5).Value 'Monitor
CheckBox3.Value = RngTarget.Offset(0, 6).Value 'Keyboard
CheckBox4.Value = RngTarget.Offset(0, 6).Value
CheckBox5.Value = RngTarget.Offset(0, 7).Value 'mouse
CheckBox6.Value = RngTarget.Offset(0, 7).Value
CheckBox7.Value = RngTarget.Offset(0, 8).Value 'Webcam
CheckBox8.Value = RngTarget.Offset(0, 8).Value
CheckBox9.Value = RngTarget.Offset(0, 9).Value 'Headset
CheckBox10.Value = RngTarget.Offset(0, 9).Value
CheckBox11.Value = RngTarget.Offset(0, 10).Value 'Speakers
CheckBox12.Value = RngTarget.Offset(0, 10).Value
CheckBox13.Value = RngTarget.Offset(0, 11).Value 'Laptop risers
CheckBox14.Value = RngTarget.Offset(0, 11).Value
TextBox3.Text = RngTarget.Offset(0, 11).Value 'other
Exit Sub
Else
'If no match is found, RngTarget is reset to the next cell that matches the first criteria.
Set RngTarget = RngSearch.Find(What:=VarCriteria(0), _
After:=RngTarget, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If RngTarget has been set back to RngPin and so no match has been found (it could hardly be the case), an error message is displayed and the macro si terminated. Otherwise the code is sent back to CP_Next_Target.
If RngTarget.Address = RngPin.Address Then
MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1) & vbCrLf & VarCriteria(2), vbCritical + vbOKOnly, "No match found"
Else
GoTo CP_Next_Target
End If
End If
End With
Exit Sub
CP_No_Match_Found:
'An error message is displayed and the macro si terminated.
MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1) & vbCrLf & VarCriteria(2), vbCritical + vbOKOnly, "No match found"
Exit Sub
End Sub
我无法真正测试它,因为我没有完整的表格。更好的代码也可能。发送反馈。