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- ի համար նախատեսված գործիքներ

jeffw

Կիրակի, 18 Դեկտեմբեր 2022

2 Գրառումներ

4.8K այցելություններ

Քվեարկել

արձակել

Ես պատճենել եմ VBA-ը՝ բջիջից տվյալները նույն տողով տարբեր սյունակում պատճենելու համար և փոխել եմ այն, որպեսզի կարողանամ փոխել բջիջը F սյունակում և պահպանել արժեքը E սյունակում, բայց երբ փորձում եմ դա ոչինչ չի լինում: Ինչ-որ մեկը կարո՞ղ է ինձ ասել, թե ինչ եմ սխալ անում: Փոփոխություն կատարելիս ես կցանկանայի նաև G սյունակում ամսաթիվը դրոշմել:

Ես հուսով էի, որ կկարողանամ անել նույն բանը, երբ փոխում եմ I սյունակի բջիջը, որպեսզի այն պահեմ սյունակ H-ում և նշեմ, որ այն փոխվում է J սյունակում:

Ցանկացած օգնություն մեծապես երախտապարտ կլինի:

Dim xRg որպես տիրույթ
Dim xChangeRg որպես միջակայք
Dim xDependRg որպես տիրույթ
Dim xDic-ը որպես նոր բառարան
Private Sub Worksheet_Change (ByVal Target as Range)
Dim I As Long
Dim xCell-ը որպես տիրույթ
Dim xDCell As Range
Dim xHeader As String
Խոնավեցրեք xCommText-ը որպես տող
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
Application.EnableEvents = False
xHeader = "Նախորդ արժեքը."
x = xDic.Keys
For I = 0 To UBound (xDic.Keys)
Սահմանել xCell = Range(xDic.Keys(I))
Սահմանել xDCell = Cells (xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
հաջորդ
Application.EnableEvents = Ճիշտ է
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Մասնավոր ենթաթերթ_SelectionChange (ByVal-ի նպատակը որպես միջակայք)
Dim I, J As Long
Dim xRgArea որպես տիրույթ
Սխալի դեպքում GoTo Label1
Եթե Target.Count > 1 Ապա Ելք Ենթ
Application.EnableEvents = False
Սահմանել xDependRg = Target.Dependents
Եթե xDependRg-ը ոչինչ է, ապա GoTo Label1
Եթե ոչ xDependRg-ը ոչինչ է, ապա
Սահմանել xDependRg = Խաչմերուկ (xDependRg, միջակայք («F:F»))
Վերջ: Եթե
Պիտակը 1:
Սահմանել xRg = Խաչմերուկ (Թիրախ, միջակայք («F:F»))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Ապա
Սահմանել xChangeRg = Union (xRg, xDependRg)
ElseIf (xRg-ը ոչինչ է) և (not xDependRg-ը ոչինչ) ապա
Սահմանեք xChangeRg = xDependRg
ElseIf (Not xRg-ը ոչինչ) և (xDependRg-ը ոչինչ չէ) Ապա
Սահմանեք xChangeRg = xRg
Ուրիշ
Application.EnableEvents = Ճիշտ է
Ելք ենթ
Վերջ: Եթե
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Սահմանել xRgArea = xChangeRg.Areas(I)
J = 1-ի համար դեպի xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J):Formula
հաջորդ
հաջորդ
Սահմանել xChangeRg = Ոչինչ
Սահմանել xRg = Ոչինչ
Սահմանել xDependRg = Ոչինչ
Application.EnableEvents = Ճիշտ է
Վերջ Sub

Թողարկում

jeffw

1 տարի առաջ

#3309

Քվեարկել

արձակել

ԹԱՐՄԱՑՆԵԼ

VBA-ն աշխատում է: Խնդրում ենք տեսնել ստորև նշված կոդը: Ես պարզապես օգնության կարիք ունեմ այն փոփոխելու հարցում, որպեսզի երբ ես փոխում եմ I սյունակի բջիջը, այն պահպանում է արժեքը սյունակ H-ում:

Dim xRg որպես տիրույթ
Dim xChangeRg որպես միջակայք
Dim xDependRg որպես տիրույթ
Dim xDic-ը որպես նոր բառարան
Private Sub Worksheet_Change (ByVal Target as Range)
Dim I As Long
Dim xCell-ը որպես տիրույթ
Dim xDCell As Range
Dim xHeader As String
Խոնավեցրեք xCommText-ը որպես տող
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
Application.EnableEvents = False
xHeader = "Նախորդ արժեքը."
x = xDic.Keys
For I = 0 To UBound (xDic.Keys)
Սահմանել xCell = Range(xDic.Keys(I))
Սահմանել xDCell = Cells (xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
հաջորդ

Եթե թիրախ: Սյունակ = 6 Ապա
Application.EnableEvents = False
Բջիջներ (Target.Row, 7): Արժեք = Ամսաթիվ
Application.EnableEvents = Ճիշտ է
Վերջ: Եթե

Եթե թիրախ: Սյունակ = 9 Ապա
Application.EnableEvents = False
Բջիջներ (Target.Row, 10): Արժեք = Ամսաթիվ
Application.EnableEvents = Ճիշտ է
Վերջ: Եթե
Application.EnableEvents = Ճիշտ է
Վերջ Sub
Մասնավոր ենթաթերթ_SelectionChange (ByVal-ի նպատակը որպես միջակայք)
Dim I, J As Long
Dim xRgArea որպես տիրույթ
Սխալի դեպքում GoTo Label1
Եթե Target.Count > 1 Ապա Ելք Ենթ
Application.EnableEvents = False
Սահմանել xDependRg = Target.Dependents
Եթե xDependRg-ը ոչինչ է, ապա GoTo Label1
Եթե ոչ xDependRg-ը ոչինչ է, ապա
Սահմանել xDependRg = Խաչմերուկ (xDependRg, միջակայք («F:F»))
Վերջ: Եթե
Պիտակը 1:
Սահմանել xRg = Խաչմերուկ (Թիրախ, միջակայք («F:F»))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Ապա
Սահմանել xChangeRg = Union (xRg, xDependRg)
ElseIf (xRg-ը ոչինչ է) և (not xDependRg-ը ոչինչ) ապա
Սահմանեք xChangeRg = xDependRg
ElseIf (Not xRg-ը ոչինչ) և (xDependRg-ը ոչինչ չէ) Ապա
Սահմանեք xChangeRg = xRg
Ուրիշ
Application.EnableEvents = Ճիշտ է
Ելք ենթ
Վերջ: Եթե
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Սահմանել xRgArea = xChangeRg.Areas(I)
J = 1-ի համար դեպի xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J):Formula
հաջորդ
հաջորդ
Սահմանել xChangeRg = Ոչինչ
Սահմանել xRg = Ոչինչ
Սահմանել xDependRg = Ոչինչ

Application.EnableEvents = Ճիշտ է
Վերջ Sub

jeffw

1 տարի առաջ

#3310

Քվեարկել

արձակել

Պարզապես պարզաբանելու համար սա կլինի ի հավելումն այն, ինչ նա արդեն անում է: Ես ուզում եմ հետևել F և I սյունակում կատարված փոփոխություններին: Կներեք շփոթության համար:

էջ:
1

Այս գրառման համար դեռևս պատասխաններ չեն տրվել:

Խնդրում ենք մուտք գործել՝ պատասխան փակցնելու համար

Դուք պետք է մուտք գործեք, որպեսզի կարողանաք պատասխան փակցնել: Մուտք գործեք՝ օգտագործելով աջ կողմում գտնվող ձևը կամ գրանցեք հաշիվ, եթե նոր եք այստեղ: Գրանցվել այստեղ »