excel 试图返回单元格的目标公式

bfhwhh0e  于 2023-02-25  发布在  其他
关注(0)|答案(1)|浏览(117)

嘿,我正试图为我的office工作簿创建一个检查,其中宏将提取已更改单元格的旧值、旧公式、新值和新公式。我正在为如何准确地设置此检查而挣扎。
任何帮助将不胜感激。此外,如果您能够提供任何改进或建议,将不胜感激
我目前掌握的情况:

Dim oldValue As String
Dim oldAddress As String
Dim oldFormula As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName as String
sSheetName = ActiveSheet.Name
If ActiveSheet.Name <>"Log Details" Then
Application.EnableEvents = False
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value = ActiveSheet.Name & "-" & Target.Address(0,0)
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value = oldValue
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value = **oldFormula**
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value = Target.Value
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value =** Target.Formula2**
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value = Environ("username")
Sheets("Log Details").Range("A" & Rows.Count).End(xlUp).Offset(1,0).Value = Now
Sheets("Log Details").Hyperlinks.Add Anchor:=Sheets("Log Details").Range("A" &           Rows.Count).End(xlUp).Offset(0,7),Address:="",SubAddress:="'"& sSheetName & "'!" & oldAddress,         TextToDisplay:=oldAddress
Application.EnableEvents=True
End If
End Sub

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

再次感谢您在这件事上的时间,我感谢所有的帮助和反馈
以上是我所尝试的,但我相信我不明白如何具体提取公式从单元格之前,它的变化,然后再次一旦单元格更新。
我是VBA的新手,非常感谢任何见解和帮助。

bxjv4tth

bxjv4tth1#

一些建议:

Dim oldFormat As String '<<<
Dim oldValue As String
Dim oldSheet As String  '<<<
Dim oldAddress As String
Dim oldFormula As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Const LOG_SHEET As String = "Log Details"
    Dim sSheetName As String, wsLog As Worksheet, previousOK As Boolean
    
    If Target.Cells.CountLarge > 1 Then Exit Sub      'can't handle multi-cell changes
    Set wsLog = ThisWorkbook.Worksheets(LOG_SHEET)
    If Sh.Name = wsLog.Name Then Exit Sub             'no logging on log sheet
    
    'is this the same cell for which previous values were captured?
    previousOK = Sh.Name = oldSheet And Target.Address = oldAddress
    
    On Error GoTo haveError 'make sure error handling is turned back on...
    Application.EnableEvents = False
    With wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow
        .Cells(1).Value = Sh.Name & "-" & Target.Address(0, 0)
        If previousOK Then 'make sure these are appropriate...
            .Cells(2).NumberFormat = oldFormat
            .Cells(2).Value = oldValue
            .Cells(3).Value = oldFormula       'shown as text...
        End If
        .Cells(4).NumberFormat = Target.NumberFormat
        .Cells(4).Value = Target.Value
        .Cells(5).Value = IIf(Target.HasFormula, "'" & Target.Formula, "")
        .Cells(6).Value = Environ("username")
        .Cells(7).Value = Now
        wsLog.Hyperlinks.Add Anchor:=.Cells(8), Address:="", _
                    SubAddress:="'" & Sh.Name & "'!" & oldAddress, _
                    TextToDisplay:=Sh.Name & " > " & oldAddress
    End With
haveError:
    Application.EnableEvents = True
    
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then 'only handling single-cell selections
        oldFormat = Target.NumberFormat '<<<
        oldValue = Target.Value
        oldSheet = Sh.Name              '<<<
        oldAddress = Target.Address
        oldFormula = IIf(Target.HasFormula, "'" & Target.Formula, "")
    End If
End Sub

主要的事情是确保当Target是一个多单元格区域时,您不会试图处理它。

相关问题