1

これはユニバーサルログシステムであり、ここと私自身が作成したものです。私はそれをかなり誇りに思っています...私は2つの問題に直面しています...誰かが解決策を手伝ってくれるならそれは素晴らしいことです。

コードは次のとおりです。

Option Explicit
Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sLogFileName As String, nFileNum As Long, sLogMessage As String

    sLogFileName = ThisWorkbook.path & Application.PathSeparator & "Log.txt"

 On Error Resume Next ' Turn on error handling
    If Target.Value <> PreviousValue Then
        ' Check if we have an error
        If Err.Number = 13 Then
           PreviousValue = 0
        End If
        ' Turn off error handling
        On Error GoTo 0
        sLogMessage = Now & Application.UserName & " changed cell " & Target.Address _
        & " from " & PreviousValue & " to " & Target.Value

        nFileNum = FreeFile                         ' next file number
        Open sLogFileName For Append As #nFileNum   ' create the file if it doesn't exist
        Print #nFileNum, sLogMessage                ' append information
        Close #nFileNum                             ' close the file
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub

ここに2つの問題があります。

  1. 複数のセルが選択され、書き込もうとすると、スクリプトはエラーになります。
  2. 誰かがセルを編集して空白のままにすると、8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to代わりに表示されます8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to Blank or Empty
4

2 に答える 2

3

マット

いくつかのこと

  1. On Error Resume Next適切な取り扱いではありません。絶対に必要な場合を除いて、絶対に必要になるまで避ける必要があります。
  2. イベントを操作しているときは、Worksheet_Changeイベントをオフにしてから、最後にオンに戻して、無限のループが発生しないようにすることをお勧めします。
  3. イベントをオフに切り替える場合は、適切なエラー処理を使用する必要があります。
  4. に1つのセルだけを格納しているPreviousValueので、ユーザーが複数のセルを選択したときにコードを実行したくないと思いますか？

これがあなたが試みていることだと思います（未テスト）？

Option Explicit

Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sLogFileName As String, nFileNum As Long, sLogMessage As String
    Dim NewVal

    On Error GoTo Whoa

    Application.EnableEvents = False

    sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"

    If Not Target.Cells.Count > 1 Then
        If Target.Value <> PreviousValue Then
            If Len(Trim(Target.Value)) = 0 Then _
            NewVal = "Blank" Else NewVal = Target.Value

            sLogMessage = Now & Application.UserName & _
            " changed cell " & Target.Address & " from " & _
            PreviousValue & " to " & NewVal

            nFileNum = FreeFile
            Open sLogFileName For Append As #nFileNum
            Print #nFileNum, sLogMessage
            Close #nFileNum
        End If
    End If
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub
于 2012-08-30T18:46:53.860 に答える
1

これは私のために働いた。理想的には、追跡対象のシートに名前付きの範囲があり、その範囲内で発生する変更のみに追跡を制限するために使用できます。

Const MAX_TRACKED_CELLS As Long = 50
Dim PreviousValues As Object

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim haveDict As Boolean, val, addr

    haveDict = Not PreviousValues Is Nothing

    If Target.Cells.Count <= MAX_TRACKED_CELLS Then
        For Each c In Target.Cells
            addr = c.Address()
            If haveDict Then
                If PreviousValues.exists(addr) Then
                    val = PreviousValues(addr)
                End If
            Else
                val = "{unknown}"
            End If

            If c.Value <> val Then
                Debug.Print "Changed:", addr, IIf(val = "", "Empty", val), _
                            " to ", IIf(c.Value = "", "Empty", c.Value)
            End If

        Next c
    End If


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim c As Range

    If PreviousValues Is Nothing Then
        Set PreviousValues = CreateObject("scripting.dictionary")
    Else
        PreviousValues.RemoveAll
    End If

    If Target.Cells.Count <= MAX_TRACKED_CELLS Then
        For Each c In Target.Cells
            PreviousValues.Add c.Address(), c.Value
        Next c
    End If

End Sub
于 2012-08-30T21:34:36.350 に答える