ΕΚΣΥΓΧΡΟΝΊΖΩ
Το VBA λειτουργεί! Δείτε τον παρακάτω κωδικό. Απλώς χρειάζομαι βοήθεια για να το τροποποιήσω, ώστε όταν αλλάζω ένα κελί στη Στήλη I να αποθηκεύει την τιμή στη Στήλη Η.
Dim xRg ως εύρος
Dim xChangeRg ως εύρος
Dim xDependRg ως εύρος
Dim xDic ως νέο λεξικό
Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim I As Long
Dim xCell ως εύρος
Dim xDCell ως εύρος
Dim xHeader ως συμβολοσειρά
Dim xCommText ως συμβολοσειρά
On Error Συνέχιση Επόμενη
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Προηγούμενη τιμή :"
x = xDic.Κλειδιά
Για I = 0 To UBound(xDic.Keys)
Ορισμός xCell = Range(xDic.Keys(I))
Ορισμός xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Επόμενο
Αν Target.Column = 6 Στη συνέχεια
Application.EnableEvents = False
Κελιά(Στόχος.Σειρά, 7).Τιμή = Ημερομηνία
Application.EnableEvents = True
End If
Αν Target.Column = 9 Στη συνέχεια
Application.EnableEvents = False
Κελιά(Στόχος.Σειρά, 10).Τιμή = Ημερομηνία
Application.EnableEvents = True
End If
Application.EnableEvents = True
Sub End
Ιδιωτικό δευτερεύον φύλλο εργασίας_SelectionChange(Στόχος ByVal ως εύρος)
Dim I, J As Long
Dim xRgArea ως εύρος
Στο σφάλμα GoTo Label1
Αν Target.Count > 1 Στη συνέχεια, βγείτε από το Sub
Application.EnableEvents = False
Ορίστε xDependRg = Target.Dependents
Εάν το xDependRg δεν είναι τίποτα, τότε GoTo Label1
Αν όχι το xDependRg δεν είναι τίποτα τότε
Ορισμός xDependRg = Τομή(xDependRg, εύρος ("F:F"))
End If
Ετικέτα 1:
Ορισμός xRg = Τομή (Στόχος, Εύρος ("F:F"))
Αν (Not xRg Is Nothing) Και (Not xDependRg Is Nothing) Τότε
Ορισμός xChangeRg = Ένωση(xRg, xDependRg)
ElseIf (xRg Is Nothing) and (Not xDependRg Is Nothing) Τότε
Ορίστε xChangeRg = xDependRg
ElseIf (Not xRg is Nothing) and (xDependRg Is Nothing) Τότε
Ορίστε xChangeRg = xRg
Αλλού
Application.EnableEvents = True
Έξοδος Sub
End If
xDic.RemoveAll
Για I = 1 To xChangeRg.Areas.Count
Ορισμός xRgArea = xChangeRg.Areas(I)
Για J = 1 Προς xRgArea.Count
xDic.Add xRgArea(J).Διεύθυνση, xRgArea(J).Τύπος
Επόμενο
Επόμενο
Ορισμός xChangeRg = Τίποτα
Ορισμός xRg = Τίποτα
Ορίστε xDependRg = Τίποτα
Application.EnableEvents = True
Sub End