无法获取WorksheetFunction类的VLookup属性

时间:2013-10-29 12:39:52

标签: excel vba excel-vba

我正在使用VBA在excel中做一些信息,我已经有一部分工作了。我正在做的是使用另一张纸从一张纸上分拣数据,而我在3套两张纸中进行相同的处理,这两张纸具有不同的数据,但格式相同。

这是我的代码:

Private Sub sortButton_Click()
Sheets("Results-SB").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("Results-gs").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("Results-XC").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal




        Sheets("Results-XC").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("Results-gs").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("Results-XC").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal



        Sheets("Results-gs").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("Results-gs").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("Results-XC").Activate
Range("D2").CurrentRegion.Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal



Dim rcount1, rcount2, t As Long
Dim rcount3 As Long

Dim sh1, sh2 As Worksheet
Dim wb As Workbook
Dim score

Set wb = ThisWorkbook
Set sh1 = Sheets("CompetitorSB")
Set sh2 = Sheets("Results-SB")



rcount1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
rcount2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row

For t = 2 To rcount2



If sh1.Range("B" & t).Value Like "*M50*" Then

        rcount2 = sh2.Cells(Rows.Count, "I").End(xlUp).Row
        sh1.Range("D" & t).Copy sh2.Range("I" & rcount2 + 1)

        With Application.WorksheetFunction
            score = .VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)
            sh2.Range("J" & rcount2 + 1).Value = score
        End With

        ElseIf sh1.Range("B" & t).Value Like "*W50*" Then

        rcount2 = sh2.Cells(Rows.Count, "I").End(xlUp).Row
        sh1.Range("D" & t).Copy sh2.Range("I" & rcount2 + 1)

        With Application.WorksheetFunction
            score = .VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)
            sh2.Range("J" & rcount2 + 1).Value = score
        End With

           ElseIf sh1.Range("B" & t).Value Like "*W*" Then
        rcount2 = sh2.Cells(Rows.Count, "F").End(xlUp).Row
        sh1.Range("D" & t).Copy sh2.Range("F" & rcount2 + 1)
        With Application.WorksheetFunction
            score = .VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)
            sh2.Range("G" & rcount2 + 1).Value = score
        End With



    End If
Next t

 For Each rngRow In sh2.Range("F2:G4").Rows
 rngRow.Font.Bold = True
 Next rngRow
 For Each rngRow In sh2.Range("I2:J4").Rows
 rngRow.Font.Bold = True
 Next rngRow

 <---------------------------- Up until here everything is working perfectly


 Set wb = ThisWorkbook
Set sh1 = Sheets("CompetitorGS")
Set sh2 = Sheets("Results-gs")



rcount1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
rcount2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row

For t = 2 To rcount2



If sh1.Range("B" & t).Value Like "*M50*" Then

        rcount2 = sh2.Cells(Rows.Count, "I").End(xlUp).Row
        sh1.Range("D" & t).Copy sh2.Range("I" & rcount2 + 1)

        With Application.WorksheetFunction
            score = .VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)
            sh2.Range("J" & rcount2 + 1).Value = score
        End With

        ElseIf sh1.Range("B" & t).Value Like "*W50*" Then

        rcount2 = sh2.Cells(Rows.Count, "I").End(xlUp).Row
        sh1.Range("D" & t).Copy sh2.Range("I" & rcount2 + 1)

        With Application.WorksheetFunction
            score = .VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)
            sh2.Range("J" & rcount2 + 1).Value = score
        End With

           ElseIf sh1.Range("B" & t).Value Like "*W*" Then
        rcount2 = sh2.Cells(Rows.Count, "F").End(xlUp).Row
        sh1.Range("D" & t).Copy sh2.Range("F" & rcount2 + 1)
        With Application.WorksheetFunction
            score = .VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)' VLOOKUP GENERALLY FAILS HERE
            sh2.Range("G" & rcount2 + 1).Value = score
        End With



    End If
Next t

 For Each rngRow In sh2.Range("F2:G4").Rows
 rngRow.Font.Bold = True
 Next rngRow
 For Each rngRow In sh2.Range("I2:J4").Rows
 rngRow.Font.Bold = True
 Next rngRow



End Sub

当设置sh1和sh2时,“SB”表格完全符合预期,但是当我尝试在“GS”或“XC”集上执行相同的排序时,我收到vlookup错误。 在“GS”中它在崩溃之前对它进行了相当大的排序但是如果我尝试使用“XC”表单进行此操作,它会更改单元格F:2以使其中有1并且就是这样。 我想不出为什么会这样,因为这些表单之间的唯一区别是数据/行的数量,格式方面它们是相同的。 我一直在谷歌搜索和交换/重写代码几个小时,但仍然没有取得任何进展。任何建议都是最受欢迎的。

1 个答案:

答案 0 :(得分:0)

您会发现删除Worksheetfunction并使用Application.Vlookup更容易:然后您可以测试错误的返回值,而不是让vlookup在找不到错误时抛出错误值。

Dim score As Variant

score = Application.VLookup(sh1.Range("D" & t).Value, sh2.Columns("A:D"), 4, 0)
sh2.Range("J" & rcount2 + 1).Value = iif(iserror(score), "Not found", score)

如上面的评论中所述,如果您使用vlookup的“完全匹配”选项,则无需对数据进行排序。