Vba 如何在跟踪单个单元格的更改时允许多个单元格选择

我对编写VBA代码非常陌生，我设置了一个代码来跟踪基本excel文件中的更改。双击单元格时，首先隐藏并重新打开“轨迹更改历史记录表”，然后单击工作簿\u SheetChange以指示要跟踪的信息，最后单击工作簿\u SheetSelectionChange

如果我只在主文件工作表上选择一个单元格，那么这段代码工作得非常好。当我选择多个单元格、行和列或要复制和粘贴时，我会收到一条运行时错误消息“13”-类型不匹配。调试代码时，会突出显示代码的这一部分：

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    oldValue = Target.Value
    oldAddress = Target.Address
    End Sub

作为一个全局变量，我写了：

Dim oldValue as String

我想跟踪每个单元格的更改，但也允许多次选择和复制粘贴而不显示错误消息

感谢您的帮助，如果您需要更多信息，请告诉我，

---

Amy

您尝试将多个单元格字符串值发送到单个变量（

oldValue

），这有点像尝试将多个单元格复制到单个单元格中

一种解决方案是创建一个数组，循环遍历每个单元格并单独处理。以下是一种针对您正在做的事情进行修改的示例：

    Dim trackChangesWS As Worksheet
    Set trackChangesWS = Sheet1 'wherever sheet these are being stored.

    Dim MaxArrayCount As Long
    MaxArrayCount = Target.Cells.Count - 1

   'Create Arrays (these could be combined for 1 with two dimensions, 
   'but keeping 2 to match your example)
    ReDim String_Array(0 To MaxArrayCount) As String
    ReDim Address_Array(0 To MaxArrayCount) As String

    Dim rCell As Range
    'loop through cells and capture address and cells
    For Each rCell In Target.Cells
        String_Array(i) = rCell.Value
        Address_Array(i) = rCell.Address
        i = i + 1
    Next rCell

    'set values on some corresponding sheet
    For i = 0 To MaxArrayCount
        trackChangesWS.Range(Address_Array(i)).Value = String_Array(i)
    Next i

---

非常感谢@pgcodereder的反馈。由于我是VBA新手，我不确定如何将上述内容集成到我编写的代码中。我完全理解我造成的错误。跟踪变更的目的是：第一张表是我们的主数据库“变更主文件”，团队A更新并维护该信息。每个变更都需要在单独的“跟踪变更”表上进行跟踪，以便我们的团队B进行评估，并使用反向链接记录所有变更。这就是我到目前为止写的内容，我认为它太基本了，不能只包含上面的数组创建和循环：

Dim oldValue As String
Dim oldAddress As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
sSheetName = "Variation Masterfile"
If ActiveSheet.Name <> "Tracked Changes" Then
Application.EnableEvents = False
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Target.Address(0, 0)
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = oldValue
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Target.Value
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Environ("username")
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Date
Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Time

Sheets("Tracked Changes").Columns("A:R").AutoFit
Application.EnableEvents = True
End If

If Target.Count > 1 Then Exit Sub
If ActiveSheet.Name <> "Tracked Changes" Then
Application.EnableEvents = False
Sheets("Tracked Changes").Hyperlinks.Add Anchor:=Sheets("Tracked Changes").Range("A" & Rows.Count).End(xlUp).Offset(0, 7), Address:="", SubAddress:="'" & sSheetName & "'!" & oldAddress, TextToDisplay:=oldAddress

Sheets("Tracked Changes").Columns("A:R").AutoFit
Application.EnableEvents = True
End If

If Target.Value <> "" Then
Target.Interior.ColorIndex = 7
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Value
oldAddress = Target.Address
End Sub

Dim oldValue作为字符串
将地址设置为字符串
私有子工作簿（ByVal Sh作为对象，ByVal目标作为范围）
暗表名称为字符串
sSheetName=“变体主文件”
如果ActiveSheet.Name“跟踪更改”，则
Application.EnableEvents=False
工作表（“跟踪的更改”）.Range（“A”和Rows.Count）.End（xlUp）.Offset（1，0）.Value=ActiveSheet.Name
工作表（“跟踪的更改”）.Range（“A”和Rows.Count）.End（xlUp）.Offset（0,1）.Value=Target.Address（0,0）
工作表（“跟踪的更改”）。范围（“A”&行数）。结束（xlUp）。偏移量（0，2）。值=旧值
工作表（“跟踪的更改”）。范围（“A”和行数）。结束（xlUp）。偏移量（0，3）。值=目标值
工作表（“跟踪的更改”）。范围（“A”和行数）。结束（xlUp）。偏移量（0，4）。值=环境（“用户名”）
工作表（“跟踪的更改”）。范围（“A”&行数）。结束（xlUp）。偏移量（0，5）。值=日期
工作表（“跟踪的更改”）。范围（“A”和行数）。结束（xlUp）。偏移量（0，6）。值=时间
图纸（“跟踪的更改”）。列（“A:R”）。自动拟合
Application.EnableEvents=True
如果结束
如果Target.Count>1，则退出Sub
如果ActiveSheet.Name“跟踪更改”，则
Application.EnableEvents=False
工作表（“跟踪的更改”）。超链接。添加锚定：=工作表（“跟踪的更改”）。范围（“A”和行数）。结束（xlUp）。偏移量（0，7），地址：=“”，子地址：=“”&表名和“！”&旧地址，文本显示：=旧地址
图纸（“跟踪的更改”）。列（“A:R”）。自动拟合
Application.EnableEvents=True
如果结束
如果Target.Value为“”，则
Target.Interior.ColorIndex=7
如果结束
端接头
私有子工作簿\u Sheet SelectionChange（ByVal Sh作为对象，ByVal目标作为范围）
oldValue=Target.Value
oldAddress=Target.Address
端接头

我找到了解决方案：

如果Target.Count>1，则退出Sub

如果Target.Count=1，则退出Sub

如果Target.Count=1，则退出Sub

如果