我有一个用户表单的VBA,它可以搜索工作表,通过组合框查找数据,并填充控件。如何将对该数据的任何更新保存回工作表?
另外,我的复选框不能正常工作。它们不显示以前检查过的内容或没有检查的内容。我该怎么解决这个问题?
我很感激有人能在这件事上说出点什么。提前谢谢你。
下面是我到目前为止掌握的代码:
Private Sub UserForm_Initialize()
'PURPOSE: Populate Combox with data from Excel Table
Dim Rng As Range
Dim WksWorksheet As Worksheet
Set WksWorksheet = Worksheets("DataSheet")
Set Rng = WksWorksheet.Range("HOH_Name_List")
CB_HOH_Name.List = Rng.Value
End Sub
'sets both values from selected line of combobox into text boxes for search
Private Sub CB_HOH_Name_Change()
HOH_FirstName.Text = CB_HOH_Name.Column(0)
HOH_LastName.Text = CB_HOH_Name.Column(1)
End Sub
Private Sub AMI_Enter()
AMI.Value = Format(((Val(HIncome.Value) / Val(HSize.Value)) / 118200), "#0%")
AMI.SelStart = Len(AMI.Value) - 1
End Sub
Private Sub B_Update_Click()
'I need something here maybe?
Rng.Offset(0, -1).Value = ApplDate.Text
Rng.Offset(0, 0).Value = HOH_FirstName.Text
Rng.Offset(0, 1).Value = HOH_LastName.Text
Rng.Offset(0, 2).Value = HSize.Text
Rng.Offset(0, 3).Value = ApplSource.Text
Rng.Offset(0, 4).Value = ReferPartner.Text
Rng.Offset(0, 5).Value = CkB_LeaseMortgage.Value
Rng.Offset(0, 6).Value = CkB_HOH_ID.Value
Rng.Offset(0, 7).Value = CkB_Adult1_ID.Value
Rng.Offset(0, 8).Value = CkB_Adult2_ID.Value
Rng.Offset(0, 9).Value = CkB_Adult3_ID.Value
Rng.Offset(0, 10).Value = CkB_Adult4_ID.Value
Rng.Offset(0, 11).Value = CkB_HOH_Income.Value
Rng.Offset(0, 12).Value = CkB_Adult1_Income.Value
Rng.Offset(0, 13).Value = CkB_Adult2_Income.Value
Rng.Offset(0, 14).Value = CkB_Adult3_Income.Value
Rng.Offset(0, 15).Value = CkB_Adult4_Income.Value
Rng.Offset(0, 16).Value = OrientationDoneDate.Text
Rng.Offset(0, 17).Value = SubsidyStartDate.Text
Rng.Offset(0, 18).Value = HIncome.Text
Rng.Offset(0, 19).Value = MaxIncome.Text
Rng.Offset(0, 20).Value = AMI.Text
Rng.Offset(0, 21).Value = RentOwn.Text
Rng.Offset(0, 22).Value = LoanNbr.Text
Rng.Offset(0, 23).Value = Staff.Text
Rng.Offset(0, 24).Value = NotesComments.Text
Rng.Offset(0, 25).Value = AddtlServicesRqstd.Text
Rng.Offset(0, 26).Value = AddtlServicesDclnd.Text
End Sub
Private Sub B_Search_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 'don't need this
Dim RngSearch As Range
Dim RngTarget As Range
Dim RngPin As Range
'Setting variables.
VarCriteria = Array(HOH_FirstName.Text, HOH_LastName.Text)
Set WksWorksheet01 = Worksheets("DataSheet")
Set WksWorksheet02 = Worksheets("Datasheet2") 'don't need this
Set WksTarget = WksWorksheet01
'Checkpoint for the second run (with second worksheet) 'I don't need this
CP_Worksheet_Restart:
'Focusing on WksTarget.
With WksTarget
'Setting RngSearch for the area to be searched in the given worksheet (WksTarget).
'searching for first name 1st which is in column 2
Set RngSearch = Range(.Cells(2, 2), .Cells(.Rows.Count, 2).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)) = 0 Then
'if no match is found, checks if we are focused on WksWorksheet02 'I don't need this
If WksTargetName = 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, checks if we are focused on WksWorksheet02
If WksTargetName = 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 = Worksheet02
GoTo CP_Worksheet_Restart
End If
End If
'Checkpoint for the next targeted range.
CP_Next_Target:
'Checking if RngTarget and the cell next to it matches both criteria
If RngTarget.Offset(0, 1).Value = VarCriteria(1) Then
'If a match is found, the data are reported and the macro is terminated
ApplDate.Text = RngTarget.Offset(0, -1).Value
HSize.Text = RngTarget.Offset(0, 2).Value
ApplSource.Text = RngTarget.Offset(0, 3).Value
ReferPartner.Text = RngTarget.Offset(0, 4).Value
CkB_LeaseMortgage.Value = RngTarget.Offset(0, 5).Value
CkB_HOH_ID.Value = RngTarget.Offset(0, 6).Value
CkB_Adult1_ID.Value = RngTarget.Offset(0, 7).Value
CkB_Adult2_ID.Value = RngTarget.Offset(0, 8).Value
CkB_Adult3_ID.Value = RngTarget.Offset(0, 9).Value
CkB_Adult4_ID.Value = RngTarget.Offset(0, 10).Value
CkB_HOH_Income.Value = RngTarget.Offset(0, 11).Value
CkB_Adult1_Income.Value = RngTarget.Offset(0, 12).Value
CkB_Adult2_Income.Value = RngTarget.Offset(0, 13).Value
CkB_Adult3_Income.Value = RngTarget.Offset(0, 14).Value
CkB_Adult4_Income.Value = RngTarget.Offset(0, 15).Value
OrientationDoneDate.Text = RngTarget.Offset(0, 16).Value
SubsidyStartDate.Text = RngTarget.Offset(0, 17).Value
HIncome.Text = RngTarget.Offset(0, 18).Value
MaxIncome.Text = RngTarget.Offset(0, 19).Value
AMI.Text = RngTarget.Offset(0, 20).Value
RentOwn.Text = RngTarget.Offset(0, 21).Value
LoanNbr.Text = RngTarget.Offset(0, 22).Value
Staff.Text = RngTarget.Offset(0, 23).Value
NotesComments.Text = RngTarget.Offset(0, 24).Value
AddtlServicesRqstd.Text = RngTarget.Offset(0, 25).Value
AddtlServicesDclnd.Text = RngTarget.Offset(0, 26).Value
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), 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 terminated.
MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1),
vbCritical + vbOKOnly, "No match found"
Exit Sub
End Sub
Private Sub B_Clear_Click()
'Clear all the text boxes
ApplDate.Text = ""
HOH_FirstName.Text = ""
HOH_LastName.Text = ""
ApplSource.Text = ""
ReferPartner.Text = ""
Staff.Text = ""
OrientationDoneDate.Text = ""
SubsidyStartDate.Text = ""
HSize.Text = ""
HIncome.Text = ""
MaxIncome.Text = ""
AMI.Text = ""
RentOwn.Text = ""
LoanNbr.Text = ""
'Uncheck CheckBoxes
CkB_LeaseMortgage.Value = False
CkB_HOH_Income.Value = False
CkB_HOH_ID.Value = False
CkB_Adult1_Income.Value = False
CkB_Adult1_ID.Value = False
CkB_Adult2_Income.Value = False
CkB_Adult2_ID.Value = False
CkB_Adult3_Income.Value = False
CkB_Adult3_ID.Value = False
CkB_Adult4_Income.Value = False
CkB_Adult4_ID.Value = False
NotesComments.Text = ""
AddtlServicesRqstd.Text = ""
AddtlServicesDclnd.Text = ""
End Sub这是我的用户表单:
发布于 2022-06-19 01:21:04
Private Sub B_Update_Click()
Dim VarCriteria As Variant
Dim WksTarget As Worksheet
Dim WksWorksheet As Worksheet
Dim RngSearch As Range
Dim RngTarget As Range
Dim RngPin As Range
'Setting variables.
VarCriteria = Array(HOH_FirstName.Text, HOH_LastName.Text)
Set WksWorksheet = Worksheets("DataSheet")
'Setting WksTarget.
Set WksTarget = WksWorksheet
With WksTarget
'Setting RngSearch for the area to be searched in the given worksheet (WksTarget). 'searching for first name 1st which is in column 2
Set RngSearch = Range(.Cells(2, 2), .Cells(.Rows.Count, 2).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)) = 0 Then
'the code is sent to CP_No_Match_Found
GoTo CP_No_Match_Found
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, the code is sent to CP_No_Match_Found
GoTo CP_No_Match_Found
End If
'Checkpoint for the next targeted range.
CP_Next_Target:
'Checking if RngTarget and the cell next to it matches both criteria
If RngTarget.Offset(0, 1).Value = VarCriteria(1) Then
RngTarget.Offset(0, -1).Value = ApplDate.Text
RngTarget.Offset(0, 0).Value = HOH_FirstName.Text
RngTarget.Offset(0, 1).Value = HOH_LastName.Text
RngTarget.Offset(0, 2).Value = HSize.Text
RngTarget.Offset(0, 3).Value = ApplSource.Text
RngTarget.Offset(0, 4).Value = ReferPartner.Text
RngTarget.Offset(0, 5).Value = CkB_LeaseMortgage.Value
RngTarget.Offset(0, 6).Value = CkB_HOH_ID.Value
RngTarget.Offset(0, 7).Value = CkB_Adult1_ID.Value
RngTarget.Offset(0, 8).Value = CkB_Adult2_ID.Value
RngTarget.Offset(0, 9).Value = CkB_Adult3_ID.Value
RngTarget.Offset(0, 10).Value = CkB_Adult4_ID.Value
RngTarget.Offset(0, 11).Value = CkB_HOH_Income.Value
RngTarget.Offset(0, 12).Value = CkB_Adult1_Income.Value
RngTarget.Offset(0, 13).Value = CkB_Adult2_Income.Value
RngTarget.Offset(0, 14).Value = CkB_Adult3_Income.Value
RngTarget.Offset(0, 15).Value = CkB_Adult4_Income.Value
RngTarget.Offset(0, 16).Value = OrientationDoneDate.Text
RngTarget.Offset(0, 17).Value = SubsidyStartDate.Text
RngTarget.Offset(0, 18).Value = HIncome.Text
RngTarget.Offset(0, 19).Value = MaxIncome.Text
RngTarget.Offset(0, 20).Value = AMI.Text
RngTarget.Offset(0, 21).Value = RentOwn.Text
RngTarget.Offset(0, 22).Value = LoanNbr.Text
RngTarget.Offset(0, 23).Value = Staff.Text
RngTarget.Offset(0, 24).Value = NotesComments.Text
RngTarget.Offset(0, 25).Value = AddtlServicesRqstd.Text
RngTarget.Offset(0, 26).Value = AddtlServicesDclnd.Text
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), 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), vbCritical + vbOKOnly, "No match found"
Exit Sub
End Subhttps://stackoverflow.com/questions/72663271
复制相似问题