求助。想自动记录更新历史，代码只能在sheet1运行

[lucia1983]

麻烦大神们给看看：

sheet1 输入原始值 如下：

产品 价格
氯化钙 74 110
氯化钙 77 130

会不定时更新价格。希望可以在sheet2 sheet3 中分别记录2种产品的历史价格（更新记录）

在网上找了个代码，只能在sheet1 中运行，而且只能写一个产品的，麻烦大神帮忙看看应该如何修改。

Dim xVal As String
Dim iVal As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
Static xCount As Integer
iVal = Application.WorksheetFunction.Count(Range("F:F"), 1)
xCount = iVal
Application.EnableEvents = False
If Target.Address = Range("B2").Address Then
Range("E3").Offset(xCount, 0).Value = Range("B2").Value
Range("F3").Offset(xCount, 0).Value = Now
xCount = xCount + 1
Else
If xVal <> Range("B2").Value Then
Range("E3").Offset(xCount, 0).Value = Range("B2").Value
Range("F3").Offset(xCount, 0).Value = Now
xCount = xCount + 1
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xVal = Range("B2").Value
End Sub


按照这个代码运行，会在sheet1 的e4，f4处显示的更新记录：
150 2019/6/6 23:58
110 2019/6/6 23:58

希望这个可以分别统计在后面专门建立的sheet中。也尝试了在后面的页面中引用sheet1的数据来计算，个别时候能算，而且只运算最靠前的sheet，多数时候，每个sheet都写这个代码，就什么都不记录了。
求指点！

[milaoshu1020]

写好了,代码如下:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objSheet As Worksheet
    Select Case Target.Address
    Case "$B$2"
        Set objSheet = Sheets(2)
    Case "$B$3"
        Set objSheet = Sheets(3)
    End Select
    
    Dim lngRow As Long
    lngRow = 1
    
    While objSheet.Cells(lngRow, 1) <> ""
        lngRow = lngRow + 1
    Wend
    
    If lngRow > 1 Then
        If CDbl(objSheet.Cells(lngRow - 1, 1)) = CDbl(Target) Then
            Exit Sub
        End If
    End If
    
    objSheet.Cells(lngRow, 1) = Target.Value
    objSheet.Cells(lngRow, 2) = Now
End Sub

运行示例:



下载地址:
链接：https://pan.baidu.com/s/1ijqrW-4Nbbr_eZei-ISpPA
提取码：wmc4

[lucia1983]

完美解决，谢谢大神