宏以检查值是否在另一个列表中，如果是，请添加今天的日期

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 的原因是我们有超过 100k 个项目，并不是每个使用它的人都会非常了解 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 |  |  |           |
+----------+-----+--+--+-----------+

Answer 2

我认为您使用 VBA 使它过于复杂。

相反，您可以使用简单的Excel公式执行此操作：

假设"工作表 B"，A 列包含已停产项目的列表。"工作表 A"列保存每个项目的名称，您希望在 E 列中显示今天的日期，只要工作表 B 中的项目匹配，请将其放在"工作表 A"E1 中并将其复制到工作表的末尾。

=IF(ISERROR(MATCH(A1,'Sheet B'!A:A, 0)), "", TODAY())

这将放置今天的日期，只要工作表 A 中的行与工作表 B 中的任何行匹配。它尝试在工作表 B 上的任何地方查找匹配项，如果没有，它将产生错误，这意味着 ISERROR 将为 TRUE，IF 语句将生成 "。如果它确实匹配，则不会有错误，并且它将生成 TODAY（）。

Answer 3

这就是我要做的：

Dim b as Variant
For j=1 to Range("A1").End(xlDown).Row 'Assuming the button is on the "B" Sheet
   b=Cells(j,1).Value 'This is your product in Sheet "B", assuming it is in the first column
   For i=1 to Sheets("A").Range("A1").End(xlDown).Row
      If Sheets("A").Cells(i,1).Value=b Then 'This would mean the product was found in the i Row
         Sheets("A").Cells(i,5)=Format(Now(), "MMM-DD-YYYY") 'Write today's date
      Exit For 'No need to keep looping
      End if
   Next i
Next j

这是非常基本的，但我相信它有效。