在Excel VBA中使用列表

使用Excelmacros（VBA）我将下面的公式插入到工作表中。 在后面的代码中，我粘贴公式作为值。

Firstrow = 2 Lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row With .Range(.Cells(Firstrow, "A"), .Cells(Lastrow, "A")) .Formula = "=IF(ISERROR(VLOOKUP(D2,Codes!$A$1:$A$14,1,FALSE))=TRUE,""YES"",""NO"")" End With 

是否有一个更好的方法只是答案是或否input列A中的单元格。我希望查找列表（代码！$ A $ 1：$ A $ 14）是在macros而不是其中一个工作表。 预先感谢您的帮助，您可能会发送我的方式！ 约旦。

Answer 1

使用Codes!$A$1:$A$14的相应值填充values数组。

代码没有评论

 Sub UpdateLookups() Dim data, values As Variant Dim Target As Range Dim x As Long values = Array("Tom", "Henry", "Frank", "Richard", "Rodger", "ect...") With Worksheets("Sheet1") Set Target = .Range("D2", .Range("D" & .Rows.Count).End(xlUp)) End With data = Target.Value For x = 1 To UBound(data, 1) data(x, 1) = IIf(IsError(Application.Match(data(x, 1), values, 0)), "YES", "NO") Next Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Target.Offset(0, -3).Value = data Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False End Sub 

代码与评论

 Sub UpdateLookups() Dim data, values As Variant Dim Target As Range Dim x As Long 'values: Array of values that will be searched values = Array("Tom", "Henry", "Frank", "Richard", "Rodger", "ect...") 'With Worksheets allows use to easily 'qualify' ranges 'The term fully qualified means that there is no ambiguity about the reference 'For instance this referenece Range("A1") changes depending on the ActiveSheet 'Worksheet("Sheet1").Range("A1") is considered a qualified reference. 'Of course Workbooks("Book1.xlsm").Worksheet("Sheet1").Range("A1") is fully qualified but it is usually overkill With Worksheets("Sheet1") 'Sets a refernce to a Range that starts at "D2" extends to the last used cell in Column D Set Target = .Range("D2", .Range("D" & .Rows.Count).End(xlUp)) End With ' Assigns the values of the Target Cells to an array data = Target.Value 'Iterate over each value of the array changing it's value based on our formula For x = 1 To UBound(data, 1) data(x, 1) = IIf(IsError(Application.Match(data(x, 1), values, 0)), "YES", "NO") Next Application.ScreenUpdating = False 'Speeds up write operations (value assignments) and formatting Application.Calculation = xlCalculationManual 'Speeds up write operations (value assignments) 'Here we assign the data array back to the Worksheet 'But we assign them 3 Columns to the left of the original Target Range Target.Offset(0, -3).Value = data Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False 'Loading the data into an Array allows us to write the data back to the worksheet in one operation 'So if there was 100K cells in the Target range we would have 'reduced the number of write operations from 100K to 1 End Sub 

Answer 2

不作为样本数据，但它看起来像这样：

 Firstrow = 2 Lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row With .Range(.Cells(Firstrow, "A"), .Cells(Lastrow, "A")) If IsError(Application.WorksheetFunction.VLookup(ThisWorkbook.Sheet(1).Range("D2"), ThisWorkbook.Sheet(Codes).Range("$A$1:$A$14"), 1, False)) Then .Value2 = "YES" Else .Value2 = "NO" End If End With 

请注意，由于我不知道工作簿的结构或工作表名称，因此我没有适当地确定范围D2。 请适应您的需求。 干杯，

Answer 3

一个Autofilter（）方法，没有循环

 Option Explicit Sub main() Dim arr As Variant arr = Array("a", "b", "c") '<--| set your lookup list With Worksheets("MyData") '<--| change "MyData" to your actual worksheet with data name With .Range("D2", .Cells(.Rows.Count, "D").End(xlUp)) '<--| reference its column "D" cells from row 2 down to last not empty one .Offset(, -3).Value = "YES" '<--| write "YES" in all corresponding cells in column "A" ("NO"s will be written after subsequent filtering) .AutoFilter field:=1, Criteria1:=arr, Operator:=xlFilterValues '<--| filter referenced cells with lookup list If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .SpecialCells(xlCellTypeVisible).Offset(, -3).Value = "NO" '<--| if any filtered cell then write "NO" in their corresponding column "A" ones End With .AutoFilterMode = False End With End Sub