Question

我正在使用Excel VBA复制粘贴。单元格R7具有公式=Max ("C77:AD81")。

R7 =月份最高价值
F7 =迄今为止的最高价值
Q7 =达到F7的日期

我想要实现的是R7 > F7，将R7值复制到F7并将Q7更改为=今天。

所有我实现的是R7更改为最大值（＆＃34; C77：AD81＆＃34;），其余代码不起作用。我的代码如下。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, r As Range, rv As Long


    If Not Intersect(Target, Range("R7")) Is Nothing Then
        Set rng = Intersect(Target, Range("R7"))
        For Each r In rng
            'Change Best Peak Flow and Date Achieved
            Select Case r.Value
            Case Is > ("F7")
            Case Range("R7").Select
            Case Range("R7").Copy
            Case Range("F7").Select
            Case Range("F7").Paste
            Case ("R7") = ("F7")
            Case Range("Q5").Select
            Range("Q5") = Today()
            Application.CutCopyMode = False
            End Select
        Next r
    End If

End Sub

Answer 1

因此，您的rng对象只有1个单元格，因为您指定了1个目标范围R7。话虽如此，您的For Each...Next声明是多余的。

我甚至根本不会使用Select Case，但是如果您以后想要建立它，我会留下它。

试一试

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ErrHandler    'Important to ensure events are reenabled
    Application.EnableEvents = False

    Dim rng As Range, r As Range, rv As Long
    Set rng = Intersect(Target, Range("R7"))
    If Not rng Is Nothing Then
        'Change Best Peak Flow and Date Achieved
        Select Case True
        Case r.Value > Range("F7").Value
            Range("F7") = Range("R7")
            Range("Q5") = Date
        End Select
    End If

    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    Application.EnableEvents = True
    MsgBox Err.Number & vbNewLine & Err.Description

End Sub

Answer 2

我的建议是不要使用.select。您可以在没有单个.select的情况下编程所有内容。记录和分析宏是学习VBA的非常好的起点，但有时它们太复杂了。我更喜欢简单的解决方案，所以试一试：

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("F7") <> Range("R7") Then
    Range("F7") = Range("R7")
    Range("Q5") = Date
End If
End Sub

Answer 3

我解决了。
这是我使用的代码。

Private Sub Worksheet_Change(ByVal Target As Range)

'Change Best Peak Flow and Date Achieved

If Range("R7").Value > Range("F7").Value Then
    Range("R7").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q5").Select
    Selection.Copy
    Range("K7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End If
End Sub

Excel VBA复制粘贴问题

3 个答案: