2013-10-29 77 views
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,就是这样。 我不明白为什么会发生这种情况,因为这些表单之间的唯一区别就是数据/行的数量,它们在格式上相同。 我一直在使用谷歌搜索和交换/重写代码几个小时,但仍没有取得任何进展。任何建议将是最受欢迎的。

+0

您是否试过单步执行代码?哪些细胞特别在第二张和第三张纸上失败? – Ratafia

+0

**描述了具体的问题 - 并包含VALID代码来重现它**。 *我们对您的整个宏不感兴趣* – 2013-10-29 12:47:20

+0

为“GS”组输入的最后一个数据在单元格F:23中,如果F有数据G,但G:23是空白的。 – Deoff

回答

0

您会发现删除Worksheetfunction并仅使用Application.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的“精确匹配”选项,对数据进行排序。

相关问题