vba - WorksheetFunction クラスの VLookup プロパティを取得できません

Question

私は VBA を使用して Excel である種の情報を処理していますが、その一部が機能しています。私がやっていることは、あるシートから別のシートを使用してデータをソートすることです.3セットの2つのシートで同じプロセスを行っています.2つのシートは異なるデータですが、同じフォーマットです。

これは私のコードです:

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 になるように変更され、それだけです。これらのシートの唯一の違いはデータ/行の量であり、形式的には同じであるため、なぜこれが起こるのかわかりません。私は数時間グーグルでコードを交換/書き換えてきましたが、まだ進歩していません。どんなアドバイスでも大歓迎です。

score 0 · Accepted Answer

を削除してを使用する方が簡単であることがわかり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 で「完全一致」オプションを使用している場合、データを並べ替える必要はありません。

vba - WorksheetFunction クラスの VLookup プロパティを取得できません

1 に答える 1

Related

Reference