修改或者改写代码。

a18b88

详见附件，谢谢！ 工作表1C列和D列可以重复，工作表2G列和H列不允许重复1.rar (8.23 KB, 下载次数: 5)

2018-6-12 14:42 上传

点击文件名下载附件

yylucke

请参考
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 2 And Target.Column < 5 Then
If Len(Cells(Target.Row, 3)) > 0 And Len(Cells(Target.Row, 4)) > 0 Then
    Tmp重复 = False: i = 3
    With Sheet2
        Do While .Cells(i, 7) <> ""
            If .Cells(i, 7) = Cells(Target.Row, 3) And .Cells(i, 8) = Cells(Target.Row, 4) Then
                MsgBox "添加重复！"
                Tmp重复 = True
                Exit Sub
            End If
            i = i + 1
        Loop
        If Not Tmp重复 Then
            LastRow = .Cells(.Cells.Rows.Count, 7).End(xlUp).Row
            .Cells(LastRow + 1, 7) = Sheet1.Cells(Target.Row, 3)
            .Cells(LastRow + 1, 8) = Sheet1.Cells(Target.Row, 4)
        End If
    End With
End If
End If
End Sub

yylucke

请参见附件

一支穿云箭

Sub tt()

Dim arr, brr, crr() As String, k%, DicA As Object, DicB As Object

  Set DicA = CreateObject("scripting.dictionary")
  Set DicB = CreateObject("scripting.dictionary")
  arr = Sheet1.Range("c3:d" & Sheet1.Range("c65536").End(3).Row)
  brr = Sheet2.Range("g3:h" & Sheet2.Range("g65536").End(3).Row)
  k = 1
  
    For i = 1 To UBound(arr)
        DicA(arr(i, 1) & "-" & arr(i, 2)) = ""   '表一装入字典
    Next
    For i = 1 To UBound(brr)
        DicB(brr(i, 1) & "-" & brr(i, 2)) = ""   '表二装入字典
    Next
    For Each d In DicA.keys
        If Not DicB.exists(d) Then
            ReDim Preserve crr(1 To 2, 1 To k)
                crr(1, k) = VBA.Split(d, "-")(0)
                crr(2, k) = VBA.Split(d, "-")(1)
                k = k + 1
        End If
    Next
   
'装入数据
If k > 1 Then
Sheet2.Range("g" & Sheet2.Range("g65536").End(3).Row + 1).Resize(UBound(crr, 2), 2) = _
Application.WorksheetFunction.Transpose(crr)
End If

End Sub

一支穿云箭

双字典加数组，大量数据的话运行速度明显提升

a18b88

谢谢您！yylucke朋友，您的二楼代码基本上已经接近我的目的要求，存在的问题是：工作表1  ”C ”  列只有姓名时，工作表2  “G ”  列只要不重复，也要作为新增添加到工作表2 “G”  列。

a18b88

一支穿云箭 朋友谢谢您！经过测试就是这个意思。衷心的感谢您！您辛苦了。

qingc0221

这附件是随意做的吗?感觉好随意

可以考虑用SQL,在sheet1中输入完后用sql在sheet2中查找,如果没有匹配就在sheet2中添加

a18b88

qingc0221 谢谢你的关注，是模拟文件。