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

xiaozhang999 · 发表于 2009-6-7 18:42

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

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 · 发表于 2009-6-8 09:32

Find(Target.Value, lookat:=xlWhole)

在这个地方加循环

xiaozhang999 · 发表于 2009-6-8 13:57

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

在这个地方加循环

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

先谢谢啦！

xiaozhang999 · 发表于 2009-6-11 17:33

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

jifuxue · 发表于 2009-8-25 13:32

学习学习

一尘一世界 · 发表于 2023-5-26 11:10

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

		自动登录	找回密码
密码			免费注册

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