返回列表 上一主題 發帖

如何利用VBA觸發儲存格產生日期.時間

  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim r%, xD As Range, xE As Range, xF As Range
  3. With Target
  4.       If .Count > 1 Then Exit Sub
  5.       If Intersect(Union([B:B], [C:C]), .Cells) Is Nothing Then Exit Sub
  6.       Application.EnableEvents = False
  7.       .Offset(0, 2).Value = Now()
  8.       r = .Row() - 1: Set xD = [D1].Offset(r, 0): Set xE = [E1].Offset(r, 0): Set xF = [F1].Offset(r, 0)
  9.       If Application.Count(xD, xE) = 2 Then xF = Int((xE - xD) * 24 * 60)
  10.       Application.EnableEvents = True
  11. End With
  12. End Sub
複製代碼
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

本帖最後由 ML089 於 2016-1-9 07:38 編輯

回復 3# man65boy

F欄直接用公式帶入

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
      If .Count > 1 Then Exit Sub
      If Intersect(Union([B:B], [C:C]), .Cells) Is Nothing Then Exit Sub
      Application.EnableEvents = False
      .Offset(0, 2).Value = Now()
      Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"
      Application.EnableEvents = True
End With
End Sub

補充:
這是 相對位置公式
Range("F" & .Row) = "=IF(COUNT(RC[-2]:RC[-1])=2,INT((RC[-1]-RC[-2])*24*60),"""")"

這是 絕對位置公式
Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 8# man65boy

這是 相對位置公式
Range("F" & .Row) = "=IF(COUNT(RC[-2]:RC[-1])=2,INT((RC[-1]-RC[-2])*24*60),"""")"

這是 絕對位置公式
Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題