请问如何用VBA判断多个单元格组合的那内容在区域中有重复

roc.jame

求助：请问A1&B1&C1作为一个值，判断其是否重复？

roc.jame

Sub CheckM()
    Set d = CreateObject("Scripting.Dictionary")
    lr = [E65536].End(3).Row
    arr = Range("C1:K" & lr)
    For i = 3 To UBound(arr)
        s = arr(i, 1) & arr(i, 3) & arr(i, 4) & arr(i, 9)
        d(s) = d(s) + 1
        If d(s) > 1 Then Cells(i, "N") = "重复"
    Next
End Sub

如何复制到另外一个工作表呢？

roc.jame

请问如何复制满足条件的到另一个工作表sheet2呢？

abc123281

不需要复制  加一行循环工作表的代码就行了

roc.jame

abc123281 发表于 2019-1-24 22:24
不需要复制  加一行循环工作表的代码就行了

我修改不好了，还在找资料

roc.jame

abc123281 发表于 2019-1-24 22:24
不需要复制  加一行循环工作表的代码就行了

您能帮我完善下不？谢谢了

abc123281

附件不太具有真实性  数据太少  所以不好弄

roc.jame

If d(s) > 1 Then  复制到其他工作表，后面的代码如何写，需要请教各位大侠

hcm19522

=IF(COUNTIFS(E:E,E2,J:J,J2)>1,"重复","")

roc.jame

Sub CheckM2() '不含物料编码
Dim d, lr, arr, i, S
Dim rng As Range
Sheet1.Columns(14).ClearContents
Sheet1.Cells.Interior.Pattern = xlNone
Sheet4.Rows("3:65536").Clear
Set rng = Sheet1.Range("A2:M2")

    Set d = CreateObject("Scripting.Dictionary")
    lr = Sheet1.[E65536].End(3).Row
    arr = Sheet1.Range("C1:K" & lr)
    j = 2
    For i = 3 To UBound(arr)
        S = arr(i, 1) & arr(i, 3) & arr(i, 4) & arr(i, 9)
        d(S) = d(S) + 1
'---------------------------------------------------------------------
'        If d(S) > 1 Then Sheet1.Rows(i).Copy Sheet4.Range("A" & j)
'        j = j + 1     '该语句不能删除空行
'---------------------------------------------------------------------
        If d(S) > 1 Then
         Sheet1.Range(Sheet1.Cells(i, 1), Sheet1.Cells(i, 13)).Interior.Color = vbRed
        Set rng = Union(rng, Sheet1.Range(Sheet1.Cells(i, "A"), Sheet1.Cells(i, "M")))
        End If
    Next
  rng.Copy Sheet4.[a3]
Sheet4.Cells(2, 1).EntireRow.Delete
'Sheet4.Cells.Interior.Pattern = xlNone   '取消填充颜色
End Sub

请问  这句Sheet4.Cells(2, 1).EntireRow.Delete   如何取消呢？