将符合条件的行加上标记

芒芒芒果

现总共有近6万个冻存细胞，要根据同一个项目下的上市细胞，判断哪些冻存细胞是符合条件的，需要将其保留下来。
附件里给了列子，望大神能帮忙写个VBA代码，符合条件的冻存细胞能在F列自动标上Y。
万分感谢了~

jokklx

F9=IF(C9=E9,"Y",IF(AND(D9<>"",COUNTIF(D:D,D9)=COUNTIF($D$2:D9,D9),FIND(D9,E9)>0,COUNTIF(E:E,E9)=COUNTIF($E$2:E9,E9)),"Y",""))
除了第九行那种情况，其他都能搞定了。公式能力一般，哈哈，

liulang0808

1. Sub °′&#197;￥1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Application.ScreenUpdating = False
   
4.     arr = [a1].CurrentRegion
   
5.     For j = UBound(arr) To 2 Step -1
   
6.         If Len(arr(j, 4)) > 0 Then
   
7.             If Not d.exists(arr(j, 4)) Then arr(j, 6) = "Y"
   
8.             d(arr(j, 4)) = ""
   
9.         End If
   
10.         If arr(j, 3) = arr(j, 5) Then arr(j, 6) = "Y"
    
11.     Next j
    
12.     [a1].CurrentRegion = arr
    
13.     Application.ScreenUpdating = True
    
14. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

芒芒芒果

jokklx 发表于 2018-8-30 18:35
F9=IF(C9=E9,"Y",IF(AND(D9"",COUNTIF(D:D,D9)=COUNTIF($D$2:D9,D9),FIND(D9,E9)>0,COUNTIF(E:E,E9)=COUNTI ...

学习了，谢谢

芒芒芒果

liulang0808 发表于 2018-8-30 18:41
附件内容供参考。。。。。。

我试了一下了，我给的例子特点不够鲜明，我把AB-1000这个项目的内容改了一下，能否再帮忙写下？
另外你给出的代码，第9行没能标记出Y呢~

liulang0808

芒芒芒果 发表于 2018-8-31 13:44
我试了一下了，我给的例子特点不够鲜明，我把AB-1000这个项目的内容改了一下，能否再帮忙写下？
另外你 ...

第九行怎么算相同的呢？
AB-2000-1-2                AB-2000-1

第十六行怎么算呢？

没有看太懂

芒芒芒果

liulang0808 发表于 2018-8-31 13:51
第九行怎么算相同的呢？
AB-2000-1-2                AB-2000-1

因为第9行至第15行A列的值相同，它们属于同一个项目。这个项目下只有第15行标记出来了，而E9与B9的值相同（若E10与B9的值相同也要标记出来），将其标记出来作为备用。
第16行因为A-3000这个项目下已经标记了22与26两个了，所以就不用标记第16行了