У меня есть два листа 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, заключается в том, что у нас более 100 тыс. Элементов, и не все, кто использует это, будут хорошо знать, что делать лучше. Итак, мы хотим иметь возможность составить список, поместить его в Excel, нажать кнопку макроса и вуаля.

Кроме того, список удаленных элементов впоследствии удаляется, поскольку информация хранится на листе A. Нам также необходимо сохранить даты, когда продукты были прекращены, поэтому очень важно, чтобы этот макрос не стирал предыдущие записи.

1
JonYork 23 Фев 2016 в 23:07

3 ответа

Лучший ответ

Вот мой ответ: пожалуйста, следите за комментариями внутри кода.

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 |  |  |           |
+----------+-----+--+--+-----------+
2
Elbert Villarreal 24 Фев 2016 в 16:54

Вот что бы я сделал:

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

Это очень просто, но я уверен, что это работает.

1
N. Pavon 23 Фев 2016 в 21:54

Я думаю, что вы слишком усложняете это, используя VBA.

Вместо этого вы можете сделать это с помощью простой формулы Excel:

Предположим, что «Лист B», столбец A содержит список снятых с производства товаров. Столбец A «Лист A» содержит имя каждого элемента, и вы хотите, чтобы сегодняшняя дата была в столбце E, если есть совпадение с элементом на листе B. Поместите это в «Лист A» E1 и скопируйте его до конца Лист.

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

При этом будет указана сегодняшняя дата, если строка на листе A соответствует любой из строк на листе B. Он пытается найти совпадение в любом месте на листе B, и если это не так, он выдаст ошибку, что означает, что ISERROR будет будет ИСТИНА, и оператор IF выдаст "". Если он совпадает, ошибки не будет, и он выдаст СЕГОДНЯ ().

1
Grade 'Eh' Bacon 23 Фев 2016 в 20:12