VBA - 创建自定义函数以检查字符串是否包含在数组中?

时间:2014-07-15 22:01:11

标签: arrays string excel-vba if-statement string-matching

我正在尝试检查当前单元格中的字符串是否与数组中找到的整个字符串匹配,但是由于某种原因,函数总是抛出错误(我猜),因为" If Not IsError(应用程序。匹配(v,arr,0))然后......"总是被跳过。

这是我到目前为止函数和调​​用它的方法的代码。

Function IsInArray(v As String, arr As Variant) As Boolean

    If Not IsError(Application.Match(v, arr, 0)) Then
        IsInArray = True

    Else
        IsInArray = False

    End If

End Function


'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------'
'--- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET -- LABOR WORKSHEET --'
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------'
Private Sub LaborTab_Setup(ByVal SheetNameString As String, ByVal JPNum As String, _
                           ByVal OID As String, ByVal SID As String)

    Dim PasteRow As Variant
    Dim LaborListString As String
    Dim MainRange As Range, Cell As Excel.Range
    Dim MainSheet As String, LaborCraftArray() As String
    Dim JobPlan_Number As String, OrgID As String, SiteID As String

    JobPlan_Number = JPNum
    OrgID = OID
    SiteID = SID
    MainSheet = SheetNameString

    'Lists all of the possible LABOR Craft Codes in a single string.
    'Seperated by only "," and no spaces!
    LaborListString = "OPER,INST,SERV,PAINT,SANDB,ELEC,BOILM," & _
             "SCAFF,WELD,RIGGER,INSUL,CATLYS,REFRA,ENG,QAQC,WATCHF,INSP,PIPEF," & _
             "MECH,XRAY,RVTECH,HYPRO,MACH,PIPEF"

    'Splits the string of Labor Crafts assigning each Craft Code to a spot within an array.
    LaborCraftArray = Split(LaborListString, ",")

    Sheets(MainSheet).Activate
    Range("D2").Select

    'Sets Range for Worksheet containing ALL information
    Set MainRange = ActiveSheet.Range(Selection, Selection.End(xlDown))

    'Keeps Track of what line to paste info in
    'Does not increase if the Craft was not found in the array
    PasteRow = 2

    For Each Cell In MainRange
        If IsInArray(Cell.Value, LaborCraftArray) Then


            'JOBLABOR.JPTASK
                Sheets(MainSheet).Select
                Range("A" & Cell.Row).Select
                Selection.Copy


            'Updates the PasteRow variables value in order to paste the copied information to the correct line
                PasteRow = PasteRow + 1

        End If

    Next Cell

End Sub

1 个答案:

答案 0 :(得分:0)

首先,如果不需要,请考虑删除所有.select.activate,因为它们总是会导致问题。另外,为什么不简化您的搜索功能:

Function IsInArray(v As String, arr As Variant) As Boolean

Dim Check As Boolean

For i = LBound(arr) to UBound(arr)
    If v = arr(i) Then
        Check = True 
        Exit For
    End If
Next

IsInArray = Bool

End Function

处理错误大多令人沮丧并可能导致问题