macros来检查值是否在另一个列表，如果是这样添加今天的date
我有两个Excel表，A包含产品和B，这是我们将停产时，库存用完。
我想要一个macros，这样我们可以在B中创build一个列表，打开run函数，然后它会去查找表A中的哪个位置，然后转到该行的E列并input今天的date。
我到目前为止的顺序是，如果没有find，就不要覆盖列中以前的条目。
我现在的基本配方是这个
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中，然后点击macrosbutton，瞧。
此外，删除的项目清单之后被删除，因为信息保存在表单A中。我们还需要保留产品停产的date，因此这个macros不会删除以前的项目。
下面是我的回答：请按照代码中的注释。
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查找产品，如果代码find任何Match产品，则使用系统date将列E设置为今天的date。 请注意，如果您想要用户公式，请参阅评论。
像这样的列表：
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 | | | | +----------+-----+--+--+-----------+
我认为你使用VBA过于复杂。
相反，你可以用一个简单的Excel公式来做到这一点：
假设“工作表B”，A栏包含已终止项目的清单。 “工作表A”列A保存每个项目的名称，并且您希望E列中的当天date与工作表B中项目匹配的任何位置。将其放在“工作表A”E1中，并将其复制到表格。
=IF(ISERROR(MATCH(A1,'Sheet B'!A:A, 0)), "", TODAY())
只要表A中的行与表B中的任何行匹配，它就会把今天的date放在这里。它试图在表B中的任何地方find一个匹配，如果不匹配，它将产生一个错误，这意味着ISERROR将为真，IF语句将产生“”。 如果匹配，则不会有错误，并且会生成TODAY（）。
这是我会做的：
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
这是非常基本的，但我相信它的工作。