Søndag 18 december 2022
  2 Svar
  4.9K besøg
0
Stemmer
Fortryd
Jeg har kopieret VBA'en til kopiering af data fra celle til samme række i en anden kolonne og ændret den, så jeg kan ændre en celle i kolonne F og gemme værdien i kolonne E, men når jeg prøver det, sker der ikke noget. Kan nogen fortælle mig, hvad jeg gør forkert? Jeg vil også gerne sætte et datostempel i kolonne G, når jeg foretager ændringen.

Jeg håbede også at kunne gøre det samme, når jeg ændrer en celle i kolonne I for at gemme den i kolonne H og datostempel for denne ændring i kolonne J.

Enhver hjælp ville være meget værdsat.


Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic som ny ordbog
Privat Sub Worksheet_Change (ByVal Target As Range)
Dim I Så længe
Dim xCell As Range
Dim xDCell As Range
Dim xHeader Som streng
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Forrige værdi:"
x = xDic.Keys
For I = 0 Til UBound(xDic.Keys)
Indstil xCell = Range(xDic.Keys(I))
Indstil xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Næste
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J Så længe
Dim xRgArea As Range
Ved fejl GoTo Label1
Hvis Target.Count > 1 Afslut Sub
Application.EnableEvents = False
Indstil xDependRg = Target.Dependents
Hvis xDependRg ikke er noget, så gå til etiket1
Hvis ikke er xDependRg ingenting, så
Indstil xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etiket 1:
Indstil xRg = Intersect(Target, Range("F:F"))
Hvis (Ikke xRg Er Intet) Og (Ikke xDependRg Er Intet) Så
Indstil xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Er Intet) Og (Ikke xDependRg Is Nothing) Så
Indstil xChangeRg = xDependRg
ElseIf (Ikke xRg Er Intet) Og (xDependRg Er Intet) Så
Indstil xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 Til xChangeRg.Areas.Count
Indstil xRgArea = xChangeRg.Areas(I)
For J = 1 Til xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formel
Næste
Næste
Indstil xChangeRg = Intet
Indstil xRg = Ingenting
Indstil xDependRg = Intet
Application.EnableEvents = True
End Sub
1 år siden
·
#3309
0
Stemmer
Fortryd
OPDATER

VBA'en virker! Se venligst koden nedenfor. Jeg har bare brug for hjælp til at ændre den, så når jeg ændrer en celle i kolonne I, gemmer den værdien i kolonne H.


Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic som ny ordbog
Privat Sub Worksheet_Change (ByVal Target As Range)
Dim I Så længe
Dim xCell As Range
Dim xDCell As Range
Dim xHeader Som streng
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Forrige værdi:"
x = xDic.Keys
For I = 0 Til UBound(xDic.Keys)
Indstil xCell = Range(xDic.Keys(I))
Indstil xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Næste

Hvis Target.Column = 6 Så
Application.EnableEvents = False
Celler(Target.Row, 7).Værdi = Dato
Application.EnableEvents = True
End If

Hvis Target.Column = 9 Så
Application.EnableEvents = False
Celler(Target.Row, 10).Værdi = Dato
Application.EnableEvents = True
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J Så længe
Dim xRgArea As Range
Ved fejl GoTo Label1
Hvis Target.Count > 1 Afslut Sub
Application.EnableEvents = False
Indstil xDependRg = Target.Dependents
Hvis xDependRg ikke er noget, så gå til etiket1
Hvis ikke er xDependRg ingenting, så
Indstil xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etiket 1:
Indstil xRg = Intersect(Target, Range("F:F"))
Hvis (Ikke xRg Er Intet) Og (Ikke xDependRg Er Intet) Så
Indstil xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Er Intet) Og (Ikke xDependRg Is Nothing) Så
Indstil xChangeRg = xDependRg
ElseIf (Ikke xRg Er Intet) Og (xDependRg Er Intet) Så
Indstil xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 Til xChangeRg.Areas.Count
Indstil xRgArea = xChangeRg.Areas(I)
For J = 1 Til xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formel
Næste
Næste
Indstil xChangeRg = Intet
Indstil xRg = Ingenting
Indstil xDependRg = Intet

Application.EnableEvents = True
End Sub
1 år siden
·
#3310
0
Stemmer
Fortryd
Bare for at præcisere, ville dette være et supplement til, hvad det allerede gør. Jeg ønsker at kunne spore ændringer foretaget i både kolonne F OG kolonne I. Beklager forvirringen.
  • Side:
  • 1
Der er endnu ingen svar på dette indlæg.