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 لا يعمل

كوتولس ل إكسيل

جيفو

الأحد، ديسمبر 18 2022

2 الردود

4.7 ألف زيارة

الأصوات

فك

لقد قمت بنسخ VBA لنسخ البيانات من الخلية إلى نفس الصف في عمود مختلف وقمت بتغييره حتى أتمكن من تغيير خلية في العمود F وحفظ القيمة في العمود E ، ولكن عندما أحاول ذلك ، لا يحدث شيء. هل يمكن لأحد أن يخبرني بما أفعله خطأ؟ أود أيضًا وضع طابع تاريخ في العمود G عندما أقوم بإجراء التغيير.

كنت آمل أيضًا أن أكون قادرًا على فعل الشيء نفسه عندما أقوم بتغيير خلية في العمود I لحفظها في العمود H وطابع التاريخ الذي يتغير في العمود J.

سيكون موضع تقدير أي مساعدة.

خافت xRg كمدى
خافت xChangeRg كنطاق
خافت xDependRg كنطاق
Dim xDic كـ قاموس جديد
ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
أنا خافت وطويلة
خافت xCell كمجموعة
خافت xDCell كمدى
خافت xHeader كسلسلة
خافت xCommText كسلسلة
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
Application.EnableEvents = خطأ
xHeader = "القيمة السابقة:"
س = xDic
بالنسبة إلى I = 0 إلى UBound (xDic.Keys)
تعيين xCell = النطاق (xDic.Keys (I))
تعيين xDCell = خلايا (xCell.Row ، 5)
xDCell.Value = ""
xDCell.Value = xDic.Items (I)
التالى
Application.EnableEvents = صحيح
Application.ScreenUpdating = ترو
نهاية الفرعية
تغيير ورقة العمل الفرعية الخاصة (الهدف حسب القيمة كنطاق)
خافت أنا ، J طالما
خافت xRgArea كمدى
عند حدوث خطأ ، انتقل إلى Label1
إذا كان Target.Count> 1 ، فاخرج من Sub
Application.EnableEvents = خطأ
قم بتعيين xDependRg = Target.Dependents
إذا كان xDependRg لا شيء ، فانتقل إلى Label1
إذا لم يكن xDependRg لا شيء إذن
تعيين xDependRg = Intersect (xDependRg، Range ("F: F"))
إنهاء حالة
التسمية 1:
تعيين xRg = تقاطع (الهدف ، النطاق ("F: F"))
إذا (ليس xRg لا شيء) و (ليس xDependRg لا شيء) إذن
اضبط xChangeRg = Union (xRg، xDependRg)
ElseIf (xRg لا شيء) و (ليس xDependRg لا شيء) إذن
قم بتعيين xChangeRg = xDependRg
ElseIf (ليس xRg لا شيء) و (xDependRg لا شيء) إذن
قم بتعيين xChangeRg = xRg
آخر
Application.EnableEvents = صحيح
خروج الفرعية
إنهاء حالة
xDic.RemoveAll
بالنسبة إلى I = 1 إلى xChangeRg.Areas.Count
قم بتعيين xRgArea = xChangeRg.Areas (I)
لـ J = 1 إلى xRgArea.Count
xDic.Add xRgArea (J). Address، xRgArea (J) .Formula
التالى
التالى
تعيين xChangeRg = لا شيء
تعيين xRg = لا شيء
قم بتعيين xDependRg = لا شيء
Application.EnableEvents = صحيح
نهاية الفرعية

القضية

جيفو

منذ 1 العام

#3309

الأصوات

فك

قم

VBA يعمل! الرجاء مراجعة التعليمات البرمجية أدناه. أحتاج فقط إلى المساعدة في تعديلها بحيث عندما أقوم بتغيير خلية في العمود الأول ، فإنها تحفظ القيمة في العمود H.

خافت xRg كمدى
خافت xChangeRg كنطاق
خافت xDependRg كنطاق
Dim xDic كـ قاموس جديد
ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
أنا خافت وطويلة
خافت xCell كمجموعة
خافت xDCell كمدى
خافت xHeader كسلسلة
خافت xCommText كسلسلة
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
Application.EnableEvents = خطأ
xHeader = "القيمة السابقة:"
س = xDic
بالنسبة إلى I = 0 إلى UBound (xDic.Keys)
تعيين xCell = النطاق (xDic.Keys (I))
تعيين xDCell = خلايا (xCell.Row ، 5)
xDCell.Value = ""
xDCell.Value = xDic.Items (I)
التالى

إذا كان Target.Column = 6 ثم
Application.EnableEvents = خطأ
الخلايا (الهدف ، الصف ، 7). القيمة = التاريخ
Application.EnableEvents = صحيح
إنهاء حالة

إذا كان Target.Column = 9 ثم
Application.EnableEvents = خطأ
الخلايا (الهدف ، الصف ، 10). القيمة = التاريخ
Application.EnableEvents = صحيح
إنهاء حالة
Application.EnableEvents = صحيح
نهاية الفرعية
تغيير ورقة العمل الفرعية الخاصة (الهدف حسب القيمة كنطاق)
خافت أنا ، J طالما
خافت xRgArea كمدى
عند حدوث خطأ ، انتقل إلى Label1
إذا كان Target.Count> 1 ، فاخرج من Sub
Application.EnableEvents = خطأ
قم بتعيين xDependRg = Target.Dependents
إذا كان xDependRg لا شيء ، فانتقل إلى Label1
إذا لم يكن xDependRg لا شيء إذن
تعيين xDependRg = Intersect (xDependRg، Range ("F: F"))
إنهاء حالة
التسمية 1:
تعيين xRg = تقاطع (الهدف ، النطاق ("F: F"))
إذا (ليس xRg لا شيء) و (ليس xDependRg لا شيء) إذن
اضبط xChangeRg = Union (xRg، xDependRg)
ElseIf (xRg لا شيء) و (ليس xDependRg لا شيء) إذن
قم بتعيين xChangeRg = xDependRg
ElseIf (ليس xRg لا شيء) و (xDependRg لا شيء) إذن
قم بتعيين xChangeRg = xRg
آخر
Application.EnableEvents = صحيح
خروج الفرعية
إنهاء حالة
xDic.RemoveAll
بالنسبة إلى I = 1 إلى xChangeRg.Areas.Count
قم بتعيين xRgArea = xChangeRg.Areas (I)
لـ J = 1 إلى xRgArea.Count
xDic.Add xRgArea (J). Address، xRgArea (J) .Formula
التالى
التالى
تعيين xChangeRg = لا شيء
تعيين xRg = لا شيء
قم بتعيين xDependRg = لا شيء

Application.EnableEvents = صحيح
نهاية الفرعية

جيفو

منذ 1 العام

#3310

الأصوات

فك

فقط للتوضيح ، سيكون هذا بالإضافة إلى ما تفعله بالفعل. أريد أن أكون قادرًا على تتبع التغييرات التي تم إجراؤها في كل من العمود F والعمود الأول. آسف للارتباك.

الصفحة:
1

لا توجد ردود لهذا المنصب حتى الآن.

يرجى تسجيل الدخول إلى مرحلة ما بعد الرد

ستحتاج إلى تسجيل الدخول لتتمكن من نشر الرد. تسجيل الدخول باستخدام النموذج على اليمين أو تسجيل حساب إذا كنت جديدا هنا. سجل هنا "