0
我正在使用VBA在Excel中执行一些信息,并且我已经部分工作。我正在做的是从另一张纸上分拣数据,并且我在三张两张纸上做了相同的处理,这两张纸有不同的数据但格式完全相同。无法获得WorksheetFunction类的VLookup属性
这是我的代码:
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“设置,我得到一个查找错误。 在“GS”集合它在崩溃之前排序了一个体面的数量,但如果我尝试使用“XC”工作表执行此操作,它会将单元格F:2更改为在其中包含1,就是这样。 我不明白为什么会发生这种情况,因为这些表单之间的唯一区别就是数据/行的数量,它们在格式上相同。 我一直在使用谷歌搜索和交换/重写代码几个小时,但仍没有取得任何进展。任何建议将是最受欢迎的。
您是否试过单步执行代码?哪些细胞特别在第二张和第三张纸上失败? – Ratafia
**描述了具体的问题 - 并包含VALID代码来重现它**。 *我们对您的整个宏不感兴趣* – 2013-10-29 12:47:20
为“GS”组输入的最后一个数据在单元格F:23中,如果F有数据G,但G:23是空白的。 – Deoff