VBA代碼效率 - 優秀範圍

我有一個代碼，我在下面運行，這工作正常。VBA代碼效率 - 優秀範圍

問題：是否有更高效的方法來編寫此代碼？（短）

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    If Not Intersect(Target, Range("D24")) Is Nothing Then 
       Sheet2.Range("D24") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D20")) Is Nothing Then 
       Sheet2.Range("D20") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D25")) Is Nothing Then 
       Sheet2.Range("D25") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D27")) Is Nothing Then 
       Sheet2.Range("D27") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D28")) Is Nothing Then 
       Sheet2.Range("D28") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D30")) Is Nothing Then 
       Sheet2.Range("D30") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D31")) Is Nothing Then 
       Sheet2.Range("D31") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 
    End If 
    If Not Intersect(Target, Range("D32")) Is Nothing Then 
       Sheet2.Range("D32") = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 

End Sub

來源

2017-09-01 James

您可以存儲地址D20，D24，D25 ..在數組中。然後遍歷數組。 –

這應該在codereview中發佈，而不是作爲代碼工作。 –

假設文本不在同一張紙上，這個？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 

If Intersect(Target, Range("D20,D24,D25,D27,D28,D30,D31,D32")) Is Nothing Then Exit Sub 
'Cancel=True 
Sheet2.Range(Target.Address).Value = "Prepared By" & " " & Environ("Username") & " " & Format(Now(), "yyyy-MM-dd hh:mm:ss") 

End Sub

來源

2017-09-01 11:11:43 SJR

非常感謝你完美的作品 – James

另一種選擇，而無需使用交集：

Option Explicit 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 

    With Target 
     If .Column = 4 Or .Column = 5 Then 
      Select Case .Row 
       Case 20, 24, 25, 27 To 28, 30 To 32 

        Application.EnableEvents = False 

        .Value2 = "Prepared By" & " " & Environ("Username") 
        .Value2 = .Value2 & " " & Format(Now, "yyyy-MM-dd hh:mm:ss") 

        Application.EnableEvents = True 

      End Select 
     End If 
    End With 
End Sub

來源

2017-09-01 11:39:02

我喜歡那樣，它比我的更優雅（而且更高效？）。 – SJR

我喜歡它運作良好。還有一個問題。我如何將這段代碼應用到第4列和第5列？ @paulbica – James

@James - 我將它更新爲'If .Column = 4或.Column = 5 Then' –

VBA代碼效率 - 優秀範圍

回答

相關問題