我的VBA代码可能更紧凑和简化 [英] Possible for my vba code more compact and simplified

问题描述

下面的我的vba代码可检查userform文本框中是否有3行上的重复数据.一旦发现重复，它将通知用户并选择重复数据的整行.它的工作并完成工作.但是，似乎代码很长且重复.是否可以简化并使我的代码更紧凑?我仍在学习vba代码，对更多高级功能以获取更紧凑的代码了解不多.谢谢你.

My vba code below to check on the userform textbox for any duplicate data on 3 rows. Once duplicate found, it will notified user and select entire row of the duplicate data. Its working and get job done. But, seems like the code quite long and repetitive. Is it possible to simplified and make my code more compact? Im still learning with vba code and dont know much about more advance function to get more compact code. Thank you.

Private Sub ISBNTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim ISBN
    Dim FoundISBN As Range
    Dim Search As String
    Dim ws As Worksheet

    Set ws = Worksheets("booklist")
    Search = ISBNTextBox.Text
    Set FoundISBN = ws.Columns(5).Find(Search, LookIn:=xlValues, Lookat:=xlWhole)
    ISBN = Application.WorksheetFunction.CountIf(ws.Range("E:E"), Me.ISBNTextBox)
    If ISBN > 0 Then
        ISBN_checker.Caption = "Duplicate" & " " & FoundISBN.Address
        FoundISBN.EntireRow.Select
    Else
        ISBN_checker.Caption = ChrW(&H2713)
    End If

End Sub
Private Sub TitleTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim Title
    Dim FoundTitle As Range
    Dim Search As String
    Dim ws As Worksheet

    Set ws = Worksheets("booklist")
    Search = TitleTextBox.Text
    Set FoundTitle = ws.Columns(2).Find(Search, LookIn:=xlValues, Lookat:=xlWhole)
    Title = Application.WorksheetFunction.CountIf(ws.Range("B:B"), Me.TitleTextBox)
    If Title > 0 Then
        Title_checker.Caption = "Duplicate" & " " & FoundTitle.Address
        FoundTitle.EntireRow.Select
    Else
        Title_checker.Caption = ChrW(&H2713)
    End If

End Sub

Private Sub CallNoTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim CallNo
    Dim FoundCallNo As Range
    Dim Search As String
    Dim ws As Worksheet

    Set ws = Worksheets("booklist")
    Search = CallNoTextBox.Text
    Set FoundCallNo = ws.Columns(6).Find(Search, LookIn:=xlValues, Lookat:=xlWhole)
    CallNo = Application.WorksheetFunction.CountIf(ws.Range("F:F"), Me.CallNoTextBox)
    If CallNo > 0 Then
        CallNo_checker.Caption = "Duplicate" & " " & FoundCallNo.Address
        FoundCallNo.EntireRow.Select
    Else
        CallNo_checker.Caption = ChrW(&H2713)
    End If

End Sub

推荐答案

那里有很多重复，而可变部分的数量有限，因此将通用代码重构为单独的Sub并对其进行参数化.

A lot of repetition there, with a limited number of variable parts, so refactor the common code into a separate Sub and parameterize it.

更简单:

Private Sub ISBNTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    DupCheck ISBNTextBox.Text, 5, ISBN_checker    
End Sub

Private Sub TitleTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    DupCheck TitleTextBox.Text, 2, Title_checker    
End Sub

Private Sub CallNoTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    DupCheck CallNoTextBox.Text, 6, CallNo_checker    
End Sub

Sub DupCheck(txt, ColNo As Long, theLabel As Object)
    Dim m
    With Worksheets("booklist")
        m = Application.Match(txt, .Columns(ColNo), 0)
        If Not IsError(m) Then '<-Fixed
            theLabel.Caption = "Duplicate" & " " & .Cells(m, ColNo).Address
            .Rows(m).Select
        Else
            theLabel.Caption = ChrW(&H2713)
        End If
    End With
End Sub

这篇关于我的VBA代码可能更紧凑和简化的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！