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



我对编写VBA代码非常陌生,我设置了一个代码来跟踪基本Excel文件中的更改。首先在双击单元格时隐藏并重新打开跟踪更改历史记录表,然后workbook_SheetChange指示我要跟踪的信息,最后是Workbook_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 As String

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

感谢您对我的帮助,如果您需要更多信息,请告诉我, 艾米

您正在尝试将多个单元格字符串值发送到单个变量(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

非常感谢您的反馈@PGCodeRider。由于我真的很陌生 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

最新更新