如何在循环中使用MATCH?

时间:2019-06-06 10:19:18

标签: excel vba

我在下面的代码中及其错误语法可能不断出现错误。

我尝试替换此行

IsInArray(pdfname, arNames(i)) = True 

与此

Application.worksheetfunction.match(pdfname, arNames(i)) = True 

但无法正常工作。

 Sub OpenPdf()

    On Error GoTo OpenPdf_Error

    Dim pdfname As String
    Dim pdf
    Const sPath = "S:\RA QUOTES 2019"
    Dim FName As String
    Dim arNames() As String
    Dim myCount As Integer
    Dim i As Integer

    FName = Dir("S:\RA QUOTES 2019\*.pdf*")
    Do Until FName = ""
        myCount = myCount + 1
        ReDim Preserve arNames(1 To myCount)
        arNames(myCount) = FName
        FName = Dir
        Loop


    pdfname = Application.InputBox("Enter the pdf you are looking for")
    pdfname = "PLQ" & pdfname




For i = 1 To UBound(arNames)

If IsInArray(pdfname, arNames(i)) = True Then

    ThisWorkbook.FollowHyperlink sPath & arNames(i)

     End If

    Next i

    On Error GoTo 0
    Exit Sub

OpenPdf_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure OpenPdf"

End Sub

2 个答案:

答案 0 :(得分:0)

这将适用于使用字典的完全匹配(具有.Exists属性的集合数据类型,该属性可让您检查字典中的键是否存在而无需每次都遍历)。

Option Explicit
Sub OpenPdf()

    Dim pdfname As String
    Dim DictPDF As New Scripting.Dictionary 'Needs Microsoft Scripting Runtime
    Const sPath = "S:\RA QUOTES 2019\"

    Dim FName As String
    Dim i As Integer

    FName = Dir(sPath & "*.pdf*")
    Do While FName <> vbNullString
        'add the name into the dictionary
        DictPDF.Add Left(LCase(pdfname), 7), 1 'Left will get the first 7 characters from the left to the name
        FName = Dir
    Loop

    pdfname = Application.InputBox("Enter the pdf you are looking for")
    pdfname = LCase("PLQ" & pdfname)

    'Check if the name is in the dictionary I used LCase because dictionaries are case sensitive,
    'so everything in low case to avoid problems.
    If DictPDF.Exists(pdfname) Then
        ThisWorkbook.FollowHyperlink sPath & DictPDF(pdfname)
    Else
        MsgBox pdfname & " was not found."
    End If

End Sub

答案 1 :(得分:0)

Sub OpenPdf()

On Error GoTo OpenPdf_Error

Dim pdfname As String
Dim pdf
Const sPath = "S:\RA QUOTES 2019\"
Dim FName As String
Dim arNames() As String
Dim myCount As Integer
Dim i As Integer

FName = Dir("S:\RA QUOTES 2019\*.pdf*")
Do Until FName = ""
    myCount = myCount + 1
    ReDim Preserve arNames(1 To myCount)
    arNames(myCount) = FName
    FName = Dir
    Loop


pdfname = Application.InputBox("Enter the pdf you are looking for")
pdfname = "PLQ" & pdfname





For i = 1 To UBound(arNames)

If InStr(1, arNames(i), pdfname, vbTextCompare) Then

MsgBox (arNames(i))

ThisWorkbook.FollowHyperlink sPath & arNames(i)

 End If

Next i

On Error GoTo 0
Exit Sub

OpenPdf_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure 
OpenPdf"

End Sub