0

我正在使用 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，仅此而已。我想不出为什么会发生这种情况，因为这些工作表之间的唯一区别是数据/行的数量，格式上它们是相同的。我已经在谷歌上搜索和交换/重写代码几个小时了，但仍然没有取得任何进展。任何建议都将受到欢迎。

4

1 回答 1

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 使用“完全匹配”选项，则无需对数据进行排序。

于 2013-10-29T15:59:21.657 回答