我正在使用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并且就是这样。 我想不出为什么会这样,因为这些表单之间的唯一区别是数据/行的数量,格式方面它们是相同的。 我一直在谷歌搜索和交换/重写代码几个小时,但仍然没有取得任何进展。任何建议都是最受欢迎的。
答案 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的“完全匹配”选项,则无需对数据进行排序。