VBA中的worksheetfunction.match属性很难

Posted 2021-04-03

当我的宏到达行时，我不断收到错误“运行时错误'91'：”对象变量或没有设置块变量“

matchrange = Workbooks("tracker test").Sheets(start_sheet).Range("F" & h).Value

我试图定义将与PL_compare_list命名范围进行比较的PLnumber。如果我尝试不定义该变量，而只是将引用直接放入下面一行的匹配函数中，而是得到错误“运行时错误'1004'：无法获取WorksheetFunction类的Match属性”

我想要做的是让这段代码看一下start_sheet上的H列，看看它是否还有数据。然后，如果没有，将F列中start_sheet上的PL编号与B列中“计算表”上的PL编号进行比较，找到一行，然后打开该行中A列中的相应文件名。思考？

这是我的完整代码，但我认为最相关的位将接近底部：

Option Explicit


Sub GetFileNames()

Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=REPLACE(CELL(""filename""),FIND(""["",CELL(""filename"")),LEN(CELL(""filename"")),MID(CELL(""filename""),FIND(""]"",CELL(""filename""),1)+1,255))&""_samples shipment PO_PL_Invoice_ attachment""&TRIM(MID(CELL(""filename""),FIND(""]"",CELL(""filename""),1)+1,255))&""_PL"""
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=left(RC[-1],len(RC[-1])-10)"

Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Dim directory As String
    directory = Range("B1").Value


Dim start_sheet As String
start_sheet = ActiveSheet.Name
Sheets("Calculation Sheet").Activate

Range("D1") = Sheets(start_sheet).Range("A1").Value

Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents

ActiveSheet.Cells(1, 1).Select

Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = directory
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & ""
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & ""
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With

Dim i As Integer
Dim j As Integer
Dim filenumber As Integer
filenumber = Evaluate("CountA(A:A)")

Columns("A:A").Select
Selection.NumberFormat = "@"
j = 1
For i = 1 To filenumber
    If InStr(1, Range("A" & i), "xlsx") Then
    ActiveSheet.Range("B" & j).Value = ActiveSheet.Range("D1").Value & ActiveSheet.Range("A" & i).Value
    j = j + 1
    End If
Next i

    Columns("B:B").Select
    Selection.Copy
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:E").Select
    Application.CutCopyMode = False
    Selection.ClearContents

Dim xlfilenumber As Integer
Dim PL_list_length As Integer

xlfilenumber = Evaluate("CountA(A:A)")
ActiveSheet.Range("A1:A" & xlfilenumber).Select
Selection.Name = "list_of_files"

For i = 1 To xlfilenumber
    Range("B" & i).Select
        ActiveCell.FormulaR1C1 = _
        "=MID(RC[-1],FIND(""_PL"",RC[-1],FIND(""_PL"",RC[-1],1)+4)+1,7)"
Next i

xlfilenumber = Evaluate("CountA(B:B)")
ActiveSheet.Range("A1:A" & xlfilenumber).Select
Selection.Name = "PL_compare_list"

Sheets(start_sheet).Activate
PL_list_length = Evaluate("CountA(F:F)") - 1



Dim h As Integer
Dim g As Integer
Dim filerownum As Integer
Dim matchrange As Range
Dim comparerange As Range
Dim filename As String

    For h = 6 To 9
            If IsEmpty(Range("J" & h)) Then
                matchrange = Workbooks("tracker test").Sheets(start_sheet).Range("F" & h).Value
                filerownum = Application.WorksheetFunction.Match(matchrange, Worksheets("Calculation Sheet").Range("PL_compare_list"), 0)
                    filename = Range("A" & filerownum).Value
                    Workbooks.Open filename
            End If

    Next h



Workbooks("tracker test").Sheets(start_sheet).Activate

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If


ActiveSheet.Cells(1, 1).Select
Application.CutCopyMode = False
Selection.ClearContents

ActiveSheet.Cells(1, 2).Select
Application.CutCopyMode = False
Selection.ClearContents

ActiveSheet.Cells(1, 3).Select
Application.CutCopyMode = False
Selection.ClearContents

End Sub

答案

理想情况下，您应该考虑一些其他更改，但要解决如何处理失败匹配的问题：

Dim filerownum As Variant
Dim rngSrch As Range

Set rngSrch = Worksheets("Calculation Sheet").Range("PL_compare_list")

For h = 6 To 9
        If IsEmpty(Range("J" & h)) Then
            matchrange = Workbooks("tracker test").Sheets(start_sheet).Range("F" & h).Value
            'drop the WorksheetFunction
            filerownum = Application.Match(matchrange, rngSrch, 0)
            'test for error return value
            If Not IsError(filerownum) Then
                filename = Range("A" & filerownum).Value
                Workbooks.Open filename
            End If
        End If

Next h