Question

我有一个名为mapping的工作表，它包含3列，分别是Fundcode（b3），subssubscription rate（c3）和赎回率（d3）

因此要从第4行中为这些标题输入值。.我想为在这些单元格中使用用户名输入的值进行审计跟踪。

我尝试了一些代码，但是并没有帮助我。由于我是宏的新手，所以我不知道如何解决它

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim strAddress As String
    Dim val
    Dim dtmTime As Date
    Dim Rw As Long

    If Intersect(Target, Range("B4:D4")) Is Nothing Then Exit Sub

    dtmTime = Now()
    val = Target.value
    strAddress = Target.Address

    Rw = Sheets("shtMapping").Range("B" & Rows.Count).End(xlUp).Row + 1
    With Sheets("shtMapping")
        .Cells(Rw, 1) = strAddress
        .Cells(Rw, 2) = val
        .Cells(Rw, 3) = dtmTime
    End With

End Sub

-

Fund Code   Subscription Rate   Redemption Rate
SGIS            0.16                     0.60
SPED            0.36                     0.40
SPEH            0.05                     0.12

因此，当我将SPED的订阅费率更新为0.15时，我需要捕获先前的值0.36，并且谁更改了此现有值（用户名）

Answer 1

我创建了一个新的工作表审核。

我有两个按钮，将EDIT和SAVE保存在映射表中。

因此，当用户单击“编辑”按钮时，将启用数据。

启用数据后，我会将值复制粘贴到另一张纸上并捕获肠子。

下面是我正在处理的代码，并且工作正常，

Sub EditMapping（）

 With shtMapping
    .Unprotect g_sPassword

    With .Range("B4:D103")
        .Locked = False
        .Interior.Color = vbYellow
         shtMapping.Range("B3:D103").Copy
         ThisWorkbook.Worksheets("Audit").Activate
         ThisWorkbook.Worksheets("Audit").Cells(1, 1).Select
         ActiveSheet.Paste
         shtMapping.Activate

    End With
    .Shapes("shaEditMode").Visible = True
    .Protect g_sPassword
End With

结束子

Answer 2

我在映射工作表中从单元格E到F创建了相同的标题，并将其隐藏在工作表中。因此，一旦按下编辑键，它就会复制到隐藏状态，并与“审核”工作表进行比较并替换它们，

Sub CopyCurrentTable（）

Application.ScreenUpdating = False
With shtMapping
    .Range("E4:G1000").ClearContents
    .Range("B4:D" & GetLastRow(shtMapping, "B", 4)).Copy
    .Range("E4").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End With

结束子

Sub SaveMapping（）

Dim bValidTable As Boolean: bValidTable = True
Dim i As Long

With shtMapping
    If .Shapes("shaEditMode").Visible Then
        .Unprotect g_sPassword
        .Range("B4:D103").Sort .Range("B4"), xlAscending
        For i = 4 To 103
            If .Range("B" & i).value = "" And .Range("C" & i).value = "" And .Range("D" & i).value = "" Then
                Exit For
            ElseIf .Range("B" & i).value = "" Or .Range("C" & i).value = "" Or .Range("D" & i).value = "" Then
                MsgBox "The table is missing critical information." & vbNewLine & "Please ensure all columns are populated in all rows of data.", vbCritical, "Error"
                bValidTable = False
                Exit For
            End If

            If .Range("B" & i).value = .Range("B" & i + 1) Then
                MsgBox "The table contains duplicate Fund Codes." & vbNewLine & "Please ensure Fund Codes are unique and try again.", vbCritical, "Error"
                bValidTable = False
                Exit For
            End If
        Next i
        If bValidTable Then
            With .Range("B4:D103")
                .Locked = True
                .Interior.Color = vbWhite
            End With
            .Shapes("shaEditMode").Visible = False

            'Identify Changes and plot to Audit table
            Call LogAuditTrail
            Call OpenMain
            ThisWorkbook.Save
        End If
        .Protect g_sPassword
    Else
        Call OpenMain
    End If
End With

结束子

Sub LogAuditTrail（）

Dim colOld As Collection
Dim colNew As Collection
Dim objNew As ClsMapping
Dim objOld As ClsMapping
Set colOld = getMappingData("E")
Set colNew = getMappingData("B")
Dim sTS As String

sTS = Format(Now, "dd-mmm-yyy hh:mm:ss")

For Each objNew In colNew
    'Detect Items Changed
    If ItemIsInCollection(colOld, objNew.getKey) Then
        Set objOld = colOld(objNew.getKey)
        If objNew.isDifferent(objOld) Then
            Call PlotToAudit(objNew, objOld, sTS, "Change")
        End If
    Else
        'Detect Items Added
        Set objOld = New ClsMapping
        Call PlotToAudit(objNew, objOld, sTS, "New")
    End If
Next objNew

'Detect Items removed
For Each objOld In colOld
    If Not ItemIsInCollection(colNew, objOld.getKey) Then
        Set objNew = New ClsMapping
        Call PlotToAudit(objNew, objOld, sTS, "Removed")
    End If
Next objOld

结束子 Sub PlotToAudit（obj1作为ClsMapping，obj2作为ClsMapping，sTS作为字符串，sType作为字符串）

Dim lRow As Long
lRow = shtAudit.Range("B1048576").End(xlUp).Row

If lRow = 3 Then
    lRow = 5
ElseIf lRow = 1048576 Then
    MsgBox "Audit sheet is full. Contact Support." & vbNewLine & "No audit trail will be saved", vbCritical, "ERROR"
    Exit Sub
Else
    lRow = lRow + 1
End If

With shtAudit
    .Unprotect g_sPassword
    .Range("B" & lRow).value = Application.UserName & "(" & Environ("USERNAME") & ")"
    .Range("C" & lRow).value = sTS
    .Range("D" & lRow).value = sType

    Select Case sType
        Case "Removed"
            .Range("E" & lRow).value = ""
            .Range("F" & lRow).value = ""
            .Range("G" & lRow).value = ""
            .Range("H" & lRow).value = obj2.FundCode
            .Range("I" & lRow).value = obj2.Subs
            .Range("J" & lRow).value = obj2.Reds
        Case "New"
            .Range("E" & lRow).value = obj1.FundCode
            .Range("F" & lRow).value = obj1.Subs
            .Range("G" & lRow).value = obj1.Reds
            .Range("H" & lRow).value = ""
            .Range("I" & lRow).value = ""
            .Range("J" & lRow).value = ""
        Case "Change"
            .Range("E" & lRow).value = obj1.FundCode
            .Range("F" & lRow).value = obj1.Subs
            .Range("G" & lRow).value = obj1.Reds
            .Range("H" & lRow).value = obj2.FundCode
            .Range("I" & lRow).value = obj2.Subs
            .Range("J" & lRow).value = obj2.Reds
    End Select
    With .Range("B" & lRow & ":J" & lRow)
        .Interior.Color = vbWhite
        .Borders.LineStyle = xlContinuou
    End With
    .Protect g_sPassword
End With

结束子

需要使用vba代码的审计跟踪代码

2 个答案: