VBA-如何比较同一列中的新条目，然后修改另一个单元格

Question

我需要将excel表单中的数据与工作表上输入数据的列进行比较，如果存在相同的数据，则将现有数据的另一个单元格更改为0。

我有需要持续记录的数据没有删除重复-跟踪"活动"的日期。

我有一个数据输入表单，其中包含Item、Date和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

我需要-"提交"按钮上的表单点击将最后一个条目中的"项目"、"日期"one_answers"活动"(上例中为$7)与工作表上的所有其他条目进行比较。

如果新项目($7)"项目"$A与$A中的任何其他项目相同，并且"日期"($B)在新项目日期($B$7)之前，并且"活动"($C)也=1，则将匹配项目的$C"活动"从1更改为0，并保留新项目$C$7=1。

我知道。。。困惑吧？！？

基本上以上面的例子为例。当我在表格上"提交"一个新条目时：

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

它应该在$A中找到日期在"1-11-19"之前的所有"I1"在$B中，并且在$C中找到日期为"1"。然后将$C中这些条目的每个"1"更改为"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 

它应该在$A中找到日期在"1-12-19"之前的所有"I2"在$B中，日期在"1"之前在$C中。然后将$C中这些条目的每个"1"更改为"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