Question

我有两张excel表，A包含产品和B，这是我们将在库存用完时停止使用的产品。

我想要一个宏，以便我们可以在B中创建一个列表，点击运行功能，然后它将找到它在表A中的位置，转到该行的E列并输入今天的日期。 / p>

到目前为止我遇到的问题是，如果找不到它，则不会覆盖列中的前一个条目。

我现在的基本公式是

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中。我们还需要保留产品停产的日期，因此这个宏不会删除之前的条目非常重要。< / p>

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产品，请设置列{{1使用系统日期作为今天的日期。注意，如果您想要用户公式，请参阅注释。

使用这样的列表：

Answer 2

我认为你使用VBA过于复杂了。

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

假设'表B'，A列包含已停产物品的清单。 “工作表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

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

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

3 个答案: