在特定的单元格上应用VBA代码
我正在使用一个审计线索来logging在Sheet One上产生的变化，并将它们logging在Sheet 2上。但是，代码工作正常，我想限制代码只在特定的单元格上运行，即（A1：L100）。 原因是我从M列开始有一些工作，所以我不想在这些工作中logging任何动作。 任何关于添加/修改以下代码的build议：
Option Explicit Public dArr As Variant Private Sub Worksheet_Calculate() Dim nArr As Variant Dim auditRecord As Range Dim i As Long Dim j As Long nArr = Me.UsedRange 'Look for changes to the used range For i = 1 To UBound(dArr, 2) For j = 1 To UBound(dArr, 1) If nArr(j, i) <> dArr(j, i) Then 'write to range If Not Write_Change(dArr(j, i), nArr(j, i), Me.Cells(j, i).Address) Then MsgBox "The change was not recorded.", vbInformation End If End If Next j Next i Erase nArr, dArr dArr = Me.UsedRange End Sub Private Sub Worksheet_Change(ByVal target As Range) Dim Cell As Range Dim oldValue As Variant For Each Cell In target On Error Resume Next oldValue = vbNullString oldValue = dArr(Cell.Row, Cell.Column) On Error GoTo 0 If oldValue <> Cell.Value Then If Not Write_Change(oldValue, Cell.Value, Cell.Address) Then MsgBox "The change was not recorded.", vbInformation End If End If Next Cell On Error Resume Next Erase dArr On Error GoTo 0 dArr = Me.UsedRange End Sub Private Sub Worksheet_SelectionChange(ByVal target As Range) dArr = Me.UsedRange End Sub Public Function Write_Change(oldValue, newValue, cellAddress As String) As Boolean Dim auditRecord As Range On Error GoTo errHandler Set auditRecord = Sheets("ChangeHistory").Range("A:A").Find("*", searchdirection:=xlPrevious).Offset(1, 0) With auditRecord .Value = cellAddress 'Address of change .Offset(0, 1).Value = newValue 'new value .Offset(0, 2).Value = oldValue 'previous value .Offset(0, 3).NumberFormat = "dd mm yyyy hh:mm:ss" .Offset(0, 3).Value = Now 'time of change .Offset(0, 4).Value = Application.UserName 'user who made change .Offset(0, 5).Value = Me.Range("D" & Split(cellAddress, "$")(2)).Value End With Write_Change = True Exit Function errHandler: Write_Change = False Debug.Print "Error number: " & Err.Number Debug.Print "Error descr: " & Err.Description End Function 在Write_Change你可以testing你的cellAddress ，看看是否你cellAddress的东西。 例如，如果您只想捕获在A1:F50更改，您可以写：
If Not(Intersect(Me.Range(cellAddress), me.Range("A1:F50")) IS NOTHING) Then Write_Change = False Exit Function End If
或类似的规定。 如果可接受单元格的范围由多个区域组成，那么可以检出UNION函数将它们拼接成一个单独的范围，您可以使用该IF Not(Intersect() Is Nothing))逻辑来testing该范围。