在 Excel VBA 中使用列表

Question

我使用 Excel 宏 (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

有没有更好的方法可以在 A 列的单元格中输入“是”或“否”的答案。我希望查找列表 (Codes!$A$1:$A$14) 在宏内部而不是在宏内部工作表之一。在此先感谢您提供的任何帮助，您可以发送我的方式！约旦。

Answer 1

用来自Codes!$A$1:$A$14 的适当值填充values 数组。

没有 cmets 的代码

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

带有 cmets 的代码

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