Skopiowałem VBA do kopiowania danych z komórki do tej samej kolumny wiersza i zmieniłem ją, aby móc zmienić komórkę w kolumnie F i zapisać wartość w kolumnie E, ale kiedy próbuję, nic się nie dzieje. Czy ktoś może mi powiedzieć, co robię źle? Chciałbym również umieścić znacznik daty w kolumnie G, kiedy dokonuję zmiany.
Miałem nadzieję, że będę mógł zrobić to samo, gdy zmienię komórkę w kolumnie I, aby zapisać ją w kolumnie H i opatrzyć datą tę zmianę w kolumnie J.
Każda pomoc byłaby bardzo doceniona.
Dim xRg jako zakres
Dim xChangeRg jako zakres
Dim xDependRg jako zakres
Dim xDic jako nowy słownik
Prywatny Sub Worksheet_Change (ByVal Target As Range)
Dim I tak długo
Przyciemnij xCell jako zakres
Przyciemnij xDCell jako zakres
Dim xHeader jako ciąg
Dim xCommText jako ciąg
On Error Resume Next
Application.ScreenUpdating = Fałsz
Application.EnableEvents = Fałsz
xHeader = "Poprzednia wartość :"
x = xDic.Klucze
Dla I = 0 To UBound(xDic.Keys)
Ustaw xCell = Range(xDic.Keys(I))
Ustaw xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Następna
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim I, J Jak długo
Dim xRgArea jako zakres
W przypadku błędu GoTo Label1
Jeśli Target.Count > 1, to wyjdź z Sub
Application.EnableEvents = Fałsz
Ustaw xDependRg = Cel.Zależne
Jeśli xDependRg to nic, to przejdź do Label1
Jeśli nie xDependRg jest niczym, to wtedy
Set xDependRg = Przecięcie(xDependRg, Range("F:F"))
End If
Etykieta 1:
Ustaw xRg = Przecięcie(Cel, Zakres("F:F"))
Jeśli (nie xRg jest niczym) i (nie xDependRg nie jest niczym) Wtedy
Ustaw xChangeRg = suma(xRg, xDependRg)
ElseIf (xRg jest niczym) i (nie xDependRg jest niczym) Wtedy
Ustaw xChangeRg = xDependRg
ElseIf (nie xRg to nic) i (xDependRg to nic) Wtedy
Ustaw xChangeRg = xRg
Więcej
Application.EnableEvents = True
Exit Sub
End If
xDic.Usuń wszystko
Dla I = 1 To xChangeRg.Areas.Count
Ustaw xRgArea = xChangeRg.Areas(I)
Dla J = 1 do xRgArea.Count
xDic.Add xRgArea(J).Adres, xRgArea(J).Formula
Następna
Następna
Ustaw xChangeRg = Nic
Ustaw xRg = Nic
Ustaw xDependRg = Nic
Application.EnableEvents = True
End Sub
Miałem nadzieję, że będę mógł zrobić to samo, gdy zmienię komórkę w kolumnie I, aby zapisać ją w kolumnie H i opatrzyć datą tę zmianę w kolumnie J.
Każda pomoc byłaby bardzo doceniona.
Dim xRg jako zakres
Dim xChangeRg jako zakres
Dim xDependRg jako zakres
Dim xDic jako nowy słownik
Prywatny Sub Worksheet_Change (ByVal Target As Range)
Dim I tak długo
Przyciemnij xCell jako zakres
Przyciemnij xDCell jako zakres
Dim xHeader jako ciąg
Dim xCommText jako ciąg
On Error Resume Next
Application.ScreenUpdating = Fałsz
Application.EnableEvents = Fałsz
xHeader = "Poprzednia wartość :"
x = xDic.Klucze
Dla I = 0 To UBound(xDic.Keys)
Ustaw xCell = Range(xDic.Keys(I))
Ustaw xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Następna
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim I, J Jak długo
Dim xRgArea jako zakres
W przypadku błędu GoTo Label1
Jeśli Target.Count > 1, to wyjdź z Sub
Application.EnableEvents = Fałsz
Ustaw xDependRg = Cel.Zależne
Jeśli xDependRg to nic, to przejdź do Label1
Jeśli nie xDependRg jest niczym, to wtedy
Set xDependRg = Przecięcie(xDependRg, Range("F:F"))
End If
Etykieta 1:
Ustaw xRg = Przecięcie(Cel, Zakres("F:F"))
Jeśli (nie xRg jest niczym) i (nie xDependRg nie jest niczym) Wtedy
Ustaw xChangeRg = suma(xRg, xDependRg)
ElseIf (xRg jest niczym) i (nie xDependRg jest niczym) Wtedy
Ustaw xChangeRg = xDependRg
ElseIf (nie xRg to nic) i (xDependRg to nic) Wtedy
Ustaw xChangeRg = xRg
Więcej
Application.EnableEvents = True
Exit Sub
End If
xDic.Usuń wszystko
Dla I = 1 To xChangeRg.Areas.Count
Ustaw xRgArea = xChangeRg.Areas(I)
Dla J = 1 do xRgArea.Count
xDic.Add xRgArea(J).Adres, xRgArea(J).Formula
Następna
Następna
Ustaw xChangeRg = Nic
Ustaw xRg = Nic
Ustaw xDependRg = Nic
Application.EnableEvents = True
End Sub