vba - 宏来检查值是否在另一个列表中，如果是，则添加今天的日期

Question

我有两张 Excel 表，A 包含产品，B 是库存用完时我们将停产的产品。

我想要一个宏，这样我们就可以在 B 中创建一个列表，点击运行功能，它会找到它在工作表 A 中的位置，转到该行的 E 列并输入今天的日期。

到目前为止，我遇到的问题是如果没有找到它，就不要让它覆盖列中以前的条目。

我现在的基本公式是这个

Sub Deletions()
Dim LastRow As Long
With Sheets("A")   '<-set this worksheet reference properly
    LastRow = .Range("A" & Cells.Rows.Count).End(xlUp).Row
    With .Range("E2:E" & LastRow)
        .Formula = "=IF(A1='B'!A1,TODAY(),)"
      .Cells = .Value2
    End With
End With
End Sub

我需要使用 VBA 的原因是我们有超过 10 万个项目，并不是每个使用它的人都会非常了解 excel。所以我们希望能够制作一个列表，把它放在excel中，然后点击宏按钮，瞧。

此外，删除的项目列表随后会被删除，因为信息保存在表 A 中。我们还需要保留产品停产的日期，所以这个宏不要删除以前的条目是非常重要的。

Answer 1

这是我的回答:
请按照代码中的注释进行操作。

Sub discontinue_Prods()
    'the button need to be on sheet B
    'In sheet B need to have a header
    Dim r
    Dim c
    Dim disRange As Range
    Dim i
    Dim shtA As Worksheet
    Dim shtB As Worksheet
    Dim dLine
    Dim E               'to store the column number of column E
    Dim A               'to store the column number of column A

    Set shtA = Sheets("A") 'storing the sheets...
    Set shtB = Sheets("B")

    shtB.Activate 'no matter you are in the workbook, always run from the sheet B,
                  'this code will do that for you.

    r = Range("A2").End(xlDown).Row 'the last row of the list
                                    'with the discounted prods
                                    'If you do not want headers,
                                    'use A1 here
    c = 1 'column A... changed if you need
    Set disRange = Range(Cells(2, c), Cells(r, c)) 'here need to change the 2 for
                                                   '1 if you do not want headers
    E = 5 'column E and A, just the numbers
    A = 1

    shtA.Activate 'go to sheet A
    For Each i In disRange 'for each item inside the list of prod going to discount
        dLine = Empty
        On Error Resume Next
        dLine = Application.WorksheetFunction.Match(i.Value, shtA.Columns(A), False)
        'here we find the row where the prod is,
        'searching for the item on the list (Sheet B).
        If Not dLine = Empty Then
            shtA.Cells(dLine, E).Value = Date 'heres we add the today date (system date)
                                         'to column E, just as text
            'IMPORTANT!
            'if you want the formula uncomment and use this:
            'Cells(dLine, E).FormulaR1C1 = "=TODAY()"
        End If
        On Error GoTo 0
    Next i
End Sub

只需遍历 Sheet B 列表中的单元格即可，然后转到 Sheet A并找到产品，如果代码找到任何 Match产品，设置栏目 E作为今天的日期，使用系统日期。请注意，如果您想使用公式，请参阅注释。

使用这样的列表:

Sheet A

+----------+-----+
| Products | Qty |
+----------+-----+
| Prod001  |  44 |
| Prod002  |  27 |
| Prod003  |  65 |
| Prod004  | 135 |
| Prod005  |  95 |
| Prod006  |  36 |
| Prod007  | 114 |
| Prod008  |  20 |
| Prod009  | 107 |
| Prod010  |   7 |
| Prod011  |  22 |
| Prod012  | 142 |
| Prod013  |  99 |
| Prod014  | 144 |
| Prod015  | 150 |
| Prod016  |  44 |
| Prod017  |  57 |
| Prod018  |  64 |
| Prod019  |  17 |
| Prod020  |  88 |
+----------+-----+


Sheet B

+----------+
| Products |
+----------+
| Prod017  |
| Prod011  |
| Prod005  |
| Prod018  |
| Prod006  |
| Prod009  |
| Prod006  |
| Prod001  |
| Prod017  |
+----------+

Result in Sheet A


+----------+-----+--+--+-----------+
| Products | Qty |  |  |           |
+----------+-----+--+--+-----------+
| Prod001  |  44 |  |  | 2/23/2016 |
| Prod002  |  27 |  |  |           |
| Prod003  |  65 |  |  |           |
| Prod004  | 135 |  |  |           |
| Prod005  |  95 |  |  | 2/23/2016 |
| Prod006  |  36 |  |  | 2/23/2016 |
| Prod007  | 114 |  |  |           |
| Prod008  |  20 |  |  |           |
| Prod009  | 107 |  |  | 2/23/2016 |
| Prod010  |   7 |  |  |           |
| Prod011  |  22 |  |  | 2/23/2016 |
| Prod012  | 142 |  |  |           |
| Prod013  |  99 |  |  |           |
| Prod014  | 144 |  |  |           |
| Prod015  | 150 |  |  |           |
| Prod016  |  44 |  |  |           |
| Prod017  |  57 |  |  | 2/23/2016 |
| Prod018  |  64 |  |  | 2/23/2016 |
| Prod019  |  17 |  |  |           |
| Prod020  |  88 |  |  |           |
+----------+-----+--+--+-----------+