I have copied the VBA for copying data from cell into same row different column and changed it so that I can change a cell in Column F and save the value to column E, but when I try it nothing happens. Can someone tell me what I am doing wrong? I would also like to place a datestamp in column G when I make the change. I was hoping to also be able to do the same thing when I change a cell in Column I to save it to Column H and datestamp that change in Column J. Any help would be greatly apprecaited. Dim xRg As Range Dim xChangeRg As Range Dim xDependRg As Range Dim xDic As New Dictionary Private Sub Worksheet_Change(ByVal Target As Range) Dim I As Long Dim xCell As Range Dim xDCell As Range Dim xHeader As String Dim xCommText As String On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False xHeader = "Previous value :" x = xDic.Keys For I = 0 To UBound(xDic.Keys) Set xCell = Range(xDic.Keys(I)) Set xDCell = Cells(xCell.Row, 5) xDCell.Value = "" xDCell.Value = xDic.Items(I) Next Application.EnableEvents = True Application.ScreenUpdating = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim I, J As Long Dim xRgArea As Range On Error GoTo Label1 If Target.Count > 1 Then Exit Sub Application.EnableEvents = False Set xDependRg = Target.Dependents If xDependRg Is Nothing Then GoTo Label1 If Not xDependRg Is Nothing Then Set xDependRg = Intersect(xDependRg, Range("F:F")) End If Label1: Set xRg = Intersect(Target, Range("F:F")) If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then Set xChangeRg = Union(xRg, xDependRg) ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then Set xChangeRg = xDependRg ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then Set xChangeRg = xRg Else Application.EnableEvents = True Exit Sub End If xDic.RemoveAll For I = 1 To xChangeRg.Areas.Count Set xRgArea = xChangeRg.Areas(I) For J = 1 To xRgArea.Count xDic.Add xRgArea(J).Address, xRgArea(J).Formula Next Next Set xChangeRg = Nothing Set xRg = Nothing Set xDependRg = Nothing Application.EnableEvents = True End Sub

全新

VBA 不工作

Excel的Kutools

傑夫

星期日，18十二月2022

2 回复

4.9K訪問

投票

復原

我已經復制了用於將數據從單元格複製到同一行不同列的 VBA 並對其進行了更改，以便我可以更改 F 列中的單元格並將值保存到 E 列，但是當我嘗試它時沒有任何反應。有人可以告訴我我做錯了什麼嗎？我還想在進行更改時在 G 列中放置一個日期戳。

當我更改列 I 中的單元格以將其保存到列 H 和列 J 中更改的日期戳時，我希望也能夠做同樣的事情。

任何幫助將不勝感激。

將 xRg 調暗為範圍
將 xChangeRg 調暗為範圍
將 xDependRg 調暗為範圍
將 xDic 調暗為新詞典
Private Sub Worksheet_Change（ByVal Target As Range）
暗淡我只要
將 xCell 調暗為範圍
將 xDCell 調暗為範圍
將 xHeader 調暗為字符串
將 xCommText 調暗為字符串
在錯誤恢復下一頁
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "上一個值："
x = xDic.Keys
對於 I = 0 到 UBound(xDic.Keys)
設置 xCell = Range(xDic.Keys(I))
設置 xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
下一頁
Application.EnableEvents = True
Application.ScreenUpdating = True
END SUB
私人子工作表_SelectionChange（ByVal Target As Range）
昏暗的我，J一樣長
將 xRgArea 調暗為範圍
出錯時轉到 Label1
如果 Target.Count > 1 則退出 Sub
Application.EnableEvents = False
設置 xDependRg = Target.Dependents
如果 xDependRg 為空則轉到 Label1
如果不是 xDependRg 什麼都不是那麼
設置 xDependRg = Intersect(xDependRg, Range("F:F"))
如果結束
標籤1：
設置 xRg = 相交（目標，範圍（“F:F”））
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) 那麼
設置 xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) 然後
設置 xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) 然後
設置 xChangeRg = xRg
其他
Application.EnableEvents = True
退出小組
如果結束
xDic.RemoveAll
對於 I = 1 至 xChangeRg.Areas.Count
設置 xRgArea = xChangeRg.Areas(I)
對於 J = 1 至 xRgArea.Count
xDic.Add xRgArea(J).地址，xRgArea(J).公式
下一頁
下一頁
設置 xChangeRg = 無
設置 xRg = 無
設置 xDependRg = 無
Application.EnableEvents = True
END SUB

問題

傑夫

1年前

#3309

投票

復原

更新

VBA 正在運行！請看下面的代碼。我只需要修改它的幫助，這樣當我更改列 I 中的單元格時，它會將值保存到列 H。

將 xRg 調暗為範圍
將 xChangeRg 調暗為範圍
將 xDependRg 調暗為範圍
將 xDic 調暗為新詞典
Private Sub Worksheet_Change（ByVal Target As Range）
暗淡我只要
將 xCell 調暗為範圍
將 xDCell 調暗為範圍
將 xHeader 調暗為字符串
將 xCommText 調暗為字符串
在錯誤恢復下一頁
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "上一個值："
x = xDic.Keys
對於 I = 0 到 UBound(xDic.Keys)
設置 xCell = Range(xDic.Keys(I))
設置 xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
下一頁

如果Target.Column = 6那麼
Application.EnableEvents = False
單元格（Target.Row，7）.Value = Date
Application.EnableEvents = True
如果結束

如果Target.Column = 9那麼
Application.EnableEvents = False
單元格（Target.Row，10）.Value = Date
Application.EnableEvents = True
如果結束
Application.EnableEvents = True
END SUB
私人子工作表_SelectionChange（ByVal Target As Range）
昏暗的我，J一樣長
將 xRgArea 調暗為範圍
出錯時轉到 Label1
如果 Target.Count > 1 則退出 Sub
Application.EnableEvents = False
設置 xDependRg = Target.Dependents
如果 xDependRg 為空則轉到 Label1
如果不是 xDependRg 什麼都不是那麼
設置 xDependRg = Intersect(xDependRg, Range("F:F"))
如果結束
標籤1：
設置 xRg = 相交（目標，範圍（“F:F”））
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) 那麼
設置 xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) 然後
設置 xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) 然後
設置 xChangeRg = xRg
其他
Application.EnableEvents = True
退出小組
如果結束
xDic.RemoveAll
對於 I = 1 至 xChangeRg.Areas.Count
設置 xRgArea = xChangeRg.Areas(I)
對於 J = 1 至 xRgArea.Count
xDic.Add xRgArea(J).地址，xRgArea(J).公式
下一頁
下一頁
設置 xChangeRg = 無
設置 xRg = 無
設置 xDependRg = 無

Application.EnableEvents = True
END SUB

傑夫

1年前

#3310

投票

復原

澄清一下，這是對它已經在做的事情的補充。我希望能夠跟踪 F 列和 I 列中所做的更改。很抱歉造成混淆。

頁：
1

有沒有為這個職位尚未作出回复。

請登錄後發表回复

您將需要登錄才能發表回复。使用右側的表單登錄，或者如果您是此處的新手，請註冊一個帳戶。在這裡註冊 ”