Excel VBA 복사 붙여 넣기 문제

Question

Excel VBA 복사 붙여 넣기 작업을하고 있습니다. 셀 R7은 수식 =Max ("C77:AD81")입니다.

의 달
• R7 = 최고 값
• F7 = 날짜 F7이 달성 된 날짜
• Q7에 최고 값

무엇을 달성하려고하는 것은 R7 > F7 경우, 복사 R7 값 F7로 변경하고 Q7을 오늘 =로 변경하십시오.

내가 달성 한 모든 것은 R7의 최대 변경 수 ("C77 : AD81")이며 나머지 코드는 작동하지 않습니다. 아래 내 코드. 당신이 R7 1 개 목표 범위를 지정했기 때문에

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 세포이다. 이 말을 듣고 For Each...Next 성명서는 중복됩니다.

나는 또한 Select Case을 전혀 사용하지 않겠지 만 나중에 나중에 빌드하려고 할 때 남겨 둘 것입니다.

이 주사를 ALL 기타 사항 서보 -OFF 사용하지 않는 것입니다

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없이 모든 것을 프로그래밍 할 수 있습니다. 매크로 기록 및 분석은 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