excel问题求助

Question

我想实现这样一个功能
Q列是出货前原始的数据，出完货之后在R2输入数据，在Q列中查询相同的数据，使之变色并把值附在对应的R列中。

Answer 1

只在excel表中实现这样的功能  我每天都要录入大量的原始数据    然后再发货之后又要把发货后的数据录入进来     但是在录入的时候数据太多  只能固定一个地方   然后再让它和原始数据里面的数查询  把相同的 显示在 后面一列  并把原始数据相同的变色

Answer 2

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row <> 2 Or Target.Column <> 18 Then Exit Sub '不是R2单元格则退出
    If Len(Target.Value) = 0 Then Exit Sub 'R2单元格空则退出
    
    Dim r
    Set r = Columns("Q:Q").Find(Target.Value)   '在Q列查找
    If r Is Nothing Then
        MsgBox "输错了!"        '没找到
    Else
        Cells(r.Row, r.Column).Interior.ColorIndex = 3    '找到后将背景色设为3(红色)，可改变
        Cells(r.Row, r.Column + 1).Interior.ColorIndex = 3
        Cells(r.Row, r.Column + 1) = Cells(r.Row, r.Column)
    End If
    Set r = Nothing: Range("R2").Select
    
End Sub

Answer 3

“输入的内容输入之后在Q列查询出来之后并赋值到对应的r列在自动保存起来”，我理解就是：比如找到Q9单元格，就把Q9单元格的值101119A0006放入R9单元格，并且Q9和R9都设为红色，不是吗？你说的自动保存是什么意思？往哪里保存？具体操作就是：
在R2单元格输入要查找的数值，如"101119A0006"，然后R9单元格显示101119A0006，并且Q9、R9背景变为红色，R9单元格再被选中，可继续输入数值查找，我试了，没问题。

Answer 4

我说的保存是  使excel表自动保存起来   因为我一下子要输入很多进来   用颜色是想区分哪些是已经发出去了   那么没有变色的就是说还没有发在仓库里面  关于变色在输入下一个的时候 上一个还是要存在的同时也是要有颜色区分的，也就是我说输入一个保存一个 变色一下  

Answer 5

我查了查  也是用了  原来我Q列的数据时前面三列的数据是用“&”合并在一起的 ，现在手写上去的话就可以了     但是录入时候输入一位数字的时候是不会弹出  错误提示对话框的。 怎么样编写也适合Q列的数据是合并的？

Answer 6

我明白你说的了，修改如下：
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row <> 2 Or Target.Column <> 18 Then Exit Sub '不是R2单元格则退出
    If Len(Target.Value) = 0 Then Exit Sub 'R2单元格空则退出
    
    Dim r
    Set r = Columns("Q:Q").Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)   '在Q列查找
    If r Is Nothing Then
        MsgBox "输错了!"        '没找到
    Else
        Cells(r.Row, r.Column).Interior.ColorIndex = 3    '找到后将背景色设为3(红色)，可改变
        Cells(r.Row, r.Column + 1).Interior.ColorIndex = 3
        Cells(r.Row, r.Column + 1) = Cells(r.Row, r.Column)
    End If
    Set r = Nothing: Range("R2").Select
    
End Sub

Answer 7

自动保存：
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row <> 2 Or Target.Column <> 18 Then Exit Sub '不是R2单元格则退出
    If Len(Target.Value) = 0 Then Exit Sub 'R2单元格空则退出
    
    Dim r
    Set r = Columns("Q:Q").Find(What:=Target.Value, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows)   '在Q列查找
    If r Is Nothing Then
        MsgBox "输错了!"        '没找到
    Else
        Cells(r.Row, r.Column).Interior.ColorIndex = 3    '找到后将背景色设为3(红色)，可改变
        Cells(r.Row, r.Column + 1).Interior.ColorIndex = 3
        Cells(r.Row, r.Column + 1) = Cells(r.Row, r.Column)
    End If
    Set r = Nothing: Range("R2").Select
    
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = TrueEnd Sub