首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >使用Userform中的VBA,我搜索并找到了数据,进行了更改,现在希望将更新的数据保存回工作表中。

使用Userform中的VBA,我搜索并找到了数据,进行了更改,现在希望将更新的数据保存回工作表中。
EN

Stack Overflow用户
提问于 2022-06-17 18:09:30
回答 1查看 41关注 0票数 1

我有一个用户表单的VBA,它可以搜索工作表,通过组合框查找数据,并填充控件。如何将对该数据的任何更新保存回工作表?

另外,我的复选框不能正常工作。它们不显示以前检查过的内容或没有检查的内容。我该怎么解决这个问题?

我很感激有人能在这件事上说出点什么。提前谢谢你。

下面是我到目前为止掌握的代码:

代码语言:javascript
复制
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

这是我的用户表单:

在这里输入图像描述

EN

回答 1

Stack Overflow用户

发布于 2022-06-19 01:21:04

代码语言:javascript
复制
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 Sub
票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/72663271

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档