Kopiral sem VBA za kopiranje podatkov iz celice v isto vrstico, drugačen stolpec in ga spremenil tako, da lahko spremenim celico v stolpcu F in shranim vrednost v stolpec E, a ko poskusim, se ne zgodi nič. Mi lahko kdo pove, kaj delam narobe? Prav tako bi želel postaviti datumski žig v stolpec G, ko naredim spremembo.

Upal sem, da bom lahko naredil isto stvar, ko spremenim celico v stolpcu I, da jo shranim v stolpec H in to spremembo označim z datumom v stolpcu J.

Vsaka pomoč bi bila zelo dobrodošla.


Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic kot nov slovar
Zasebni poddelovni list_Spremeni (ByVal Target As Range)
Dim I As Long
Zatemni xCell kot obseg
Zatemni xDCell kot obseg
Zatemni xHeader kot niz
Dim xCommText kot niz
On Error Resume Next
Application.ScreenUpdating = Napačno
Application.EnableEvents = False
xHeader = "Prejšnja vrednost:"
x = xDic.Keys
Za I = 0 za UBound(xDic.Keys)
Nastavite xCell = Range(xDic.Keys(I))
Nastavi xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Naslednji
Aplikacija EnableEvents = True
Application.ScreenUpdating = Res
End Sub
Zasebni pod delovni list_Sprememba izbora(ByVal Target As Range)
Dim I, J As Long
Zatemni xRgArea kot obseg
Ob napaki GoTo Label1
Če je Target.Count > 1, potem zapustite sub
Application.EnableEvents = False
Nastavite xDependRg = Target.Dependents
Če xDependRg ni nič, potem pojdi na oznako1
Če ni xDependRg, potem ni nič
Nastavite xDependRg = Intersect(xDependRg, Range("F:F"))
Konec Če
Oznaka1:
Nastavite xRg = presek (cilj, obseg ("F:F"))
Če (Ni xRg ni nič) In (Ni xDependRg ni nič) Potem
Nastavite xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg ni nič) in (not xDependRg ni nič) potem
Nastavite xChangeRg = xDependRg
ElseIf (Ni xRg ni nič) In (xDependRg ni nič) Potem
Nastavite xChangeRg = xRg
Else
Aplikacija EnableEvents = True
Exit Sub
Konec Če
xDic.RemoveAll
Za I = 1 Za xChangeRg.Areas.Count
Nastavi xRgArea = xChangeRg.Areas(I)
Za J = 1 To xRgArea.Count
xDic.Dodaj xRgArea(J).Naslov, xRgArea(J).Formula
Naslednji
Naslednji
Nastavite xChangeRg = nič
Nastavite xRg = Nič
Nastavite xDependRg = nič
Aplikacija EnableEvents = True
End Sub