VBA - Как сравнить новую запись в том же столбце, а затем изменить другую ячейку

Question

Мне нужно сравнить данные из формы Excel со столбцом на листе, в который они вводят данные, затем, если эти же данные есть, измените другую ячейку для уже существующих данных на 0.

IУ меня есть данные, которые должны постоянно регистрироваться, НЕТ стирая дубликаты - Даты отслеживания «Активны».

У меня есть форма ввода данных с Элементом, датой и 1 (1 показывает, что он активен в эту дату).Форма вводит данные в последнюю строку / следующую пустую строку на листе "ItemData".

$A="Item"    $B="Date"    $C="Active(1)"

    $A |    $B    | $C  
$1  I1 |  1-5-19  | 1 
$2  I2 |  1-8-19  | 1
$3  I3 |  1-9-19  | 1
$4  I1 |  1-9-19  | 1
$5  I4 |  1-9-19  | 1
$6  I2 |  1-10-19 | 1
$7  Next time submit button click data goes here

Мне нужно - Форма на кнопке "Отправить" Нажмите Сравнить "Элемент", "Дата и" Активна "в последней записи $ 7 в приведенном выше примере для всех других записей на листе.

Если новая запись ($ 7) «Элемент» $ A такая же, как и любая другая запись в $ A И the »Дата "($ B) предшествует дате создания нового элемента ($ B $ 7), а значение" Активный "($ C) также = 1. Затем измените значение $ C" Активное "с 1 на 0 для соответствующего элемента и оставьте новую запись $ C$ 7 = 1.

Я знаю ... Непонятно, правда?!?

В основном возьмите пример выше. Когда я "Отправить" в форме новую запись:

    $A |    $B     | $C  
$7  I1 |  1-11-19  | 1 

Он должен найти все "I1" в $ A с датами перед "1-11-19" в $ B и с "1" в $ C. Затем замените каждую "1" в $ C для этих записей на "0 ".

Пример:

      $A |    $B    | $C  
  $1  I1 |  1-5-19  | 0 
  $2  I2 |  1-8-19  | 1
  $3  I3 |  1-9-19  | 1
  $4  I1 |  1-9-19  | 0
  $5  I4 |  1-9-19  | 1
  $6  I2 |  1-10-19 | 1
  $7  I1 |  1-11-19 | 1

Затем, конечно, следующее" Отправить "в форме для другой новой записи:

    $A |    $B     | $C  
$8  I2 |  1-12-19  | 1 

Должен найти все"I2" в $ A с датами до "1-12-19" в $ B и с "1 "в $ C.Затем замените каждое «1» в $ C для этих записей на «0».

Пример:

      $A |    $B    | $C  
  $1  I1 |  1-5-19  | 0 
  $2  I2 |  1-8-19  | 0
  $3  I3 |  1-9-19  | 1
  $4  I1 |  1-9-19  | 0
  $5  I4 |  1-9-19  | 1
  $6  I2 |  1-10-19 | 0
  $7  I1 |  1-11-19 | 1
  $8  I2 |  1-12-19 | 1 

Я пытался и потерпел неудачу так много разных попыток кода, что это смущает, поэтому я не могу отправить «Мой код», потому что я, очевидно, не знаю, с чего начать,Пожалуйста, если кто-то может помочь с этим, я действительно ценю это!

============================================================================

ОБНОВЛЕНИЕ

Хорошо, я не мог понять, как это сделать с помощью автофильтра ... Но сейчас у меня есть хороший фундамент!Мне все еще нужна помощь, чтобы изменить это.

Мне нужно условие, чтобы изменить только дубликаты, у которых есть дата, предшествующая дате в поле формы "txtDate" или самой новой записи на листе (последний столбец строки D).

Вот текущий код:

Dim i As Long
Dim j As Long
Dim lDuplicates As Long
Dim rngCheck As Range
Dim rngCell As Range
Dim rngDuplicates() As Range

'Range
Set rngCheck = ws.Range("$A:$A")

'# of Duplicates found
lDuplicates = 0

'Checking cells in range
For Each rngCell In rngCheck.Cells
    Debug.Print rngCell.Address

'Check non empty cells only
    If Not IsEmpty(rngCell.Value) Then

     'Resize & clear duplicate array
        ReDim rngDuplicates(0 To 0)
     'Setting counter
        i = 0

      'Search method
        Set rngDuplicates(i) = rngCheck.Find(What:=rngCell.Value, After:=rngCell, LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

      'Check if duplicates exist
        If rngDuplicates(i).Address <> rngCell.Address Then

          'Count duplicates
            lDuplicates = lDuplicates + 1

          'If duplicates exsist then continue filling array
            Do While rngDuplicates(i).Address <> rngCell.Address
                i = i + 1
                ReDim Preserve rngDuplicates(0 To i)
                Set rngDuplicates(i) = rngCheck.FindNext(rngDuplicates(i - 1))
            Loop

          'Set the value of duplicates to 0 and number format to text
            For j = 0 To UBound(rngDuplicates, 1) - 1
                       rngDuplicates(j).Offset(0, 5).Value = "0"
                       rngDuplicates(j).Offset(0, 5).NumberFormat = "@"
            Next j
        End If
    End If
Next rngCell

Answer 1

Может быть не красиво, но это работает ...

Рабочий код:

Dim i As Long
Dim j As Long
Dim k As Long
Dim lConNbr As Long
Dim lConDate As Long
Dim lConYes As Long
Dim StartRow As Long
Dim LastRow As Long
Dim lVal1 As Long
Dim lVal2 As Date
Dim lVal3 As Long
Dim lDup As Long
Dim rngCheck As Range
Dim rngCell As Range
Dim rngDup() As Range

StartRow = 2

'Set Variable Names
lVal1 = Me.cboNbr.Value
lVal2 = Me.txtDate.Value
lVal3 = Me.txtYes.Value

'Set Check Range
Set rngCheck = ws.Range("$A:$A")

'Number of Duplicates Found
lDup = 0

'Checking each cell in range
For Each rngCell In rngCheck.Cells

     'Checking only non empty cells
     If Not IsEmpty(rngCell.Value) Then

          'Resizing and clearing duplicate array
          ReDim rngDup(0 To 0)

          'Setting counter to start
          i = 0

          'Starting search method
           Set rngDup(i) = rngCheck.Find(What:=rngCell.Value, LookIn:=xlValues, _
                           LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

          'Check if at least one duplicate
          If rngDup(i).Address <> rngCell.Address Then

               'Counting duplicates
               lDup = lDup + 1

                         'If yes, continue filling array
                              Do While rngDup(i).Address <> rngCell.Address
                                   i = i + 1
                                   ReDim Preserve rngDup(0 To i)
                                   Set rngDup(i) = rngCheck.FindNext(rngDup(i - 1))
                              Loop

               For k = StartRow To lrow
                    lConNbr = ws.Range("A" & k).Value
                    lConDate = ws.Range("D" & k).Value
                    lConYes = ws.Range("F" & k).Value

                    'Make changes to duplicate cells
                    If lVal1 = lConNbr And lVal3 = lConYes Then
                         For j = 0 To UBound(rngDup, 1) - 1
                              rngDup(j).Offset(0, 5).NumberFormat = "@"
                              rngDup(j).Offset(0, 5).Value = "0"
                         Next j
                    End If
               Next k
          End If
     End If
Next rngCell