我想批量粘贴时也能实现查找引用功能？如何写代码？

xiaozhang999

用下面的代码实现查找引用，并限制重复录入，单个录入的时候正常，但我想批量粘贴时也能实现查找引用功能？如何写代码？
现在的代码单个输入的时候能实现查找引用，但同时粘贴多个单元格的时候就不能用了！新手恳请帮忙！

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1
  If Target.Value <> "" And Application.CountIf(Columns(1), Target.Value) > 1 Then   
    MsgBox "请不要重复录入"
    Application.Undo
   End If
Set c = Sheets("物料表").Range("a2:a65536").Find(Target.Value, lookat:=xlWhole)

If Not c Is Nothing Then
Target.Offset(0, 1) = c.Offset(0, 1)
Target.Offset(0, 2) = c.Offset(0, 2)
Target.Offset(0, 4) = c.Offset(0, 5)
End If
End If
End Sub

nickxie

Find(Target.Value, lookat:=xlWhole)

在这个地方加循环

xiaozhang999

原帖由 nickxie 于 2009-6-8 09:32 发表
Find(Target.Value, lookat:=xlWhole)

在这个地方加循环

能帮忙修改一下吗？我不知道该怎么处理了！  但有两个注意点：1，单个输入的时候要能实现查询显示功能。 2，同时粘贴几个的时候也能查询显示！


先谢谢啦！

xiaozhang999

各位大哥大姐，帮帮忙啊！

jifuxue

学习学习

一尘一世界

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1
    Dim InputCells As Range
    Set InputCells = Target.Resize(Target.Rows.Count)
   
    For Each Cell In InputCells
        If Cell.Value <> "" And Application.CountIf(Columns(1), Cell.Value) > 1 Then
            MsgBox "请不要重复录入"
            Application.Undo
        End If
        Set c = Sheets("物料表").Range("a2:a65536").Find(Cell.Value, lookat:=xlWhole)
        
        If Not c Is Nothing Then
            Cell.Offset(0, 1) = c.Offset(0, 1)
            Cell.Offset(0, 2) = c.Offset(0, 2)
            Cell.Offset(0, 4) = c.Offset(0, 5)
        End If
    Next
End If
End Sub