如何使用 VBA 自动更新单元格？

问题描述

我正在尝试让单元格 K21 根据填充到单元格 H21 中的数据填充百分比回报。

但是，当稍后填充单元格 I21 时，我希望单元格 K21 中的百分比回报基于单元格 I21 中的此数据。

除此之外，我还希望输入 I21 的值复制并填充单元格 H21。

我已经设法使用 VBA 来完成复制部分，但是它没有完成上面详述的第一部分。

这是我在单元格 K21 中使用的当前公式：

=IF(COUNT(I21)=1,SUM((I21-D21)/((D21+I21)/2)*1),"")

如果有人能提出任何改变，那就太好了。

这是当前的 VBA :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("C:C"),.Cells) Is nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0,-1).ClearContents
                Else
                    With .Offset(0,-1)
                        .NumberFormat = "dd mmm yy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
        With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("I:I"),7).ClearContents
                Else
                    With .Offset(0,7)
                        .NumberFormat = "dd mmm yy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
    
    Const sCell As String = "I2" ' Source First Cell
    Const dCol As Variant = "H" ' Destination Column Id (String or Index)
    
    Dim irg As Range ' Intersect Range
    Dim cOffset As Long ' Column Offset
    With Range(sCell)
        Set irg = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1),Target)
        If irg Is nothing Then Exit Sub
        cOffset = Columns(dCol).Column - .Column
    End With
    
    Dim arg As Range ' Current Area of Intersect Range
    Dim cel As Range ' Current Cell in Current Area of Intersect Range
    For Each arg In irg.Areas
        For Each cel In arg.Cells
            If Not IsError(cel.Value) Then
                cel.Offset(,cOffset).Value = cel.Value
            End If
        Next cel
    Next arg
    
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）