请各大虾出手相助

zzmm1274

请各大虾出手相助，我想将附件中Sheet1中的“参照表”移至Sheet2，不知如何修改代码，谢谢！

zzmm1274

Private Sub Worksheet_Change(ByVal Target As Range)
'如果更改的单元格不是C列第3行以下的单元格或更改的单元格个数大于1时退出程序
    If Application.Intersect(Target, Range("C3:C65536")) Is Nothing Or Target.Count > 1 Then
        Exit Sub
    End If
    Dim i As Integer   '定义变量
    i = 3              '参照表中第1条记录在第3行，所以初值设为3
    Do While Sheet2.Cells(i, "I").Value <> ""             '在参照表里循环
        '判断录入的字母与参照表的字母是否相符
        If UCase(Target.Value) = Sheet2.Cells(i, "I").Value Then
            Application.EnableEvents = False    '禁用事件，防止将字母改为商品名称时，再次执行程序
            Target.Value = Sheet2.Cells(i, "I").Offset(0, 1).Value         '写入产品名称
            Target.Offset(0, -1).Value = Date                       '写入销售日期
            Target.Offset(0, 1) = Cells(i, "I").Offset(0, 2).Value  '写入商品代码
            Target.Offset(0, 2) = Cells(i, "I").Offset(0, 3).Value  '写入商品单价
            Target.Offset(0, 3).Select             '选中销售数量列，等待输入销售数量
            Application.EnableEvents = True        '重新启用事件
            Exit Sub
        End If
        i = i + 1
    Loop
End Sub

zzmm1274

自己想通了，哈哈！