Question

我正在尝试获取SourceSheet.Range（“C2：C”和LastRowSource）中保存的所有值，并将它们与ReferenceSheet.Range中保存的所有值交叉引用（“F7：F”＆amp; LastRowReference）。如果它们不在该范围内，那么我想删除在C列中保存该值的整个行。问题：
1.它返回错误“无法获取WorksheetFunction类的Vlookup属性”。即使没有这个错误，我也不能100％确定我的代码是正确的还是有效的。谢谢！

 Sub FiltrarCalypso()
 Dim Sourcebook As Workbook
 Dim SourceSheet As Worksheet
 Dim Referencebook As Workbook
 Dim ReferenceSheet As Worksheet
 Dim LastRowSource As Long
 Dim LastRowReference As Long
 Dim FindString As String

 Set Sourcebook = Workbooks("Nemail")
 Set SourceSheet = Sourcebook.Worksheets("QP")
 Set Referencebook = Workbooks("Op")
 Set ReferenceSheet = Referencebook.Worksheets("OP")
 LastRowSource = SourceSheet.Cells(Rows.Count, "C").End(xlUp).Row
 LastRowReference = ReferenceSheet.Cells(Rows.Count, "A").End(xlUp).Row

 For i = 2 To LastRowSource
     FindString = Application.WorksheetFunction.VLookup(SourceSheet.Range("C" & i),     ReferenceSheet.Range("F7:F" & LastRowReference), 1, False)
If FindString <> 1 Then
SourceSheet.Range("A" & i & ":z" & i).Delete
Else: End if


 Next i

 End Sub

Answer 1

这看起来很接近。第一个问题，在删除行/列时应始终反向循环。接下来，我更喜欢使用.Find()而不是工作表函数。这将循环并尝试在参考表的F列中找到Range("C" & i)的值。它通过将变量“FindString”（我更改为范围）设置为Range.Find()（返回范围）来实现。如果找不到值，则“FindString”将不存在，If语句将评估为true，整个行将从源表中删除。

 Sub FiltrarCalypso()
 Dim Sourcebook As Workbook
 Dim SourceSheet As Worksheet
 Dim Referencebook As Workbook
 Dim ReferenceSheet As Worksheet
 Dim LastRowSource As Long
 Dim LastRowReference As Long
 Dim FindString As Range

 Application.ScreenUpdating = False

 Set Sourcebook = Workbooks("Nemail")
 Set SourceSheet = Sourcebook.Worksheets("QP")
 Set Referencebook = Workbooks("Op")
 Set ReferenceSheet = Referencebook.Worksheets("OP")
 LastRowSource = SourceSheet.Cells(Rows.Count, "C").End(xlUp).Row
 LastRowReference = ReferenceSheet.Cells(Rows.Count, "A").End(xlUp).Row

 For i = LastRowSource to 2 Step -1 'Step -1 tells this to loop in reverse
     On Error Resume Next
     Set FindString = ReferenceSheet.Range("F:F").Find (SourceSheet.Range("C" & i)

If FindString Is Nothing Then
SourceSheet.Range("A" & i).EntireRow.Delete
End if

Next i

End Sub

编辑：

我相信下面应该更快。它将列C中每个单元格的值写入二维数组（SourceArray）中的第一个“列”，并将该单元格的行索引写入SourceArray的第二个“列”。然后它将ReferenceSheet中F列的所有值写入名为ReferenceArray的1-D数组。然后它反过来循环通过SourceArray（）（因为我们向前写入数组，我们想要向后循环，所以我们先删除最高的数字行）并将它与ReferenceArray（）中的每个值进行比较。如果找到该值，则将标志（flg）设置为true，并退出内部循环。如果flg = True，那么我们什么也不做（找到了值），否则，我们删除与SourceArray（i，1）中的值相关联的行。

如果这实际上回答了您的问题，请标记为已回答！

 Sub FiltrarCalypso()
 Dim Sourcebook As Workbook
 Dim SourceSheet As Worksheet
 Dim Referencebook As Workbook
 Dim ReferenceSheet As Worksheet
 Dim LastRowSource As Long
 Dim LastRowReference As Long
 Dim FindString, C As Range
 Dim SourceArray() as String
 Dim ReferenceArray() as String
 Dim RowArray()
 Dim i, j as integer
 Dim flg as Boolean

 Set Sourcebook = Workbooks("Nemail")
 Set SourceSheet = Sourcebook.Worksheets("QP")
 Set Referencebook = Workbooks("Op")
 Set ReferenceSheet = Referencebook.Worksheets("OP")
 LastRowSource = SourceSheet.Cells(Rows.Count, "C").End(xlUp).Row
 LastRowReference = ReferenceSheet.Cells(Rows.Count, "A").End(xlUp).Row

 Redim SourceArray(0 to LastRowReference - 2,0 to 1)
 Redim ReferenceArray(0 to LastRowSource - 7)

 For i = 0 to Ubound(SourceArray())
   SourceArray(i,0) = SourceSheet.Cells(i+2,3)
   SourceArray(i,1) = SourceSheet.Cells(i+2,3).Row
 Next i

 For i = 0 to Ubound(ReferenceArray())
   ReferenceArray(i,0) = ReferenceSheet.Cells(i+7,6)
 Next i

 For i = Ubound(SourceArray()) to 0 Step -1
   flg = False
   For j = 0 to  Ubound(ReferenceArray())
      If SourceArray(i,0) =  ReferenceArray(i) Then
         flg = True
         Exit For
      End if
   Next j
   If flg = False Then
    SourceSheet.Range("A" & SourceArray(i,1)).EntireRow.Delete
   End if
Next i     



End Sub

VLOOKUP删除不匹配参考值的值

1 个答案: