hvordan kan jeg se hvem der har rettet i et enkelt ark?

Jeg har først tid i aften, men jeg mener at det kan laves.

kabbak

Sæt dette ind i hver arks modul, men ikke i Særlige.

Private Sub Worksheet_Change(ByVal Target As Range)
Call Hvem
End Sub

Den næste sættes ind i et modul

Public Sub Hvem()
A = ActiveSheet.Name
C = ActiveCell.Address
Application.ScreenUpdating = False
Sheets("Særlige").Select
Range("G1").Select
Nr = Selection.End(xlDown).Row
If Range("G2") = "" Then Nr = 1
Range("G" & Nr + 1) = Now
Range("H" & Nr + 1) = A
Range("I" & Nr + 1) = C
Range("K" & Nr + 1) = Application.UserName
Worksheets(A).Select
Application.ScreenUpdating = True
End Sub

En mulighed er også at dele / Share regnearket.
På den måde kan man lave en automatisk historik over alle ændringer i regneark.

bak -> hvis jeg deler/Share regnearket, kan jeg ikke få lov til at redigere makroer eller se dem.

Jeg ved ikke om det kun er Excel 2000 der er sådan, men det er den jeg har.

Ny en, lav et nyt ark og omdøb den til Log.
overskrifter i log A1 til E1
Tidspunkt    Ark    Celle    Ændret til    Person


Sæt dette ind i hver arks modul, men ikke i Log.

Private Sub Worksheet_Change(ByVal Target As Range)
Call Hvem(Target)
End Sub

Den næste sættes ind i et modul

Public Sub Hvem(Target)
A = ActiveSheet.Name
C = Target.Address
Application.ScreenUpdating = False
Sheets("Log").Select
Range("A1").Select
Nr = Selection.End(xlDown).Row
If Range("A2") = "" Then Nr = 1
Range("A" & Nr + 1) = Now
Range("B" & Nr + 1) = A
Range("C" & Nr + 1) = C
Range("D" & Nr + 1) = Target
Range("E" & Nr + 1) = Application.UserName
Worksheets(A).Select
Application.ScreenUpdating = True
End Sub

Kabbak -> Vældig god ide :-)
Hvis jeg må forslå et par småændringer så indsæt dette som overskrifterne på Log-arket

Tidspunkt    Ark    Celle    Ændret fra    Ændret til    Person

Det kunne jo også være rart at se hvad det var ændret fra.
Dette kræver at der defineres en public variabel "BeforeVal" i det alm. modul og at makroerne i arkets kodemodul ser således ud:
'*****
Private Sub Worksheet_Change(ByVal Target As Range)
    Call Hvem(Target)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    BeforeVal = Target.Formula
End Sub
'*****

Jeg har tilladt mig at fjerne select-sætningerne, for at gøre koden hurtigere.

'*******
Public BeforeVal As String

Public Sub Hvem(Target)
Dim rng As Range
Dim A As String
Dim C As String
A = ActiveSheet.Name
C = Target.Address
Set rng = Sheets("Log").Range("A65536").End(xlUp).Offset(1, 0)
rng.Value = Now
rng.Offset(0, 1) = A
rng.Offset(0, 2) = C
rng.Offset(0, 3) = "'" & BeforeVal
rng.Offset(0, 4) = "'" & Target.Formula
rng.Offset(0, 5) = Application.UserName
End Sub
'*******

Bak -->
Jeg havde også tænkt på 'Ændret fra', men vidste ikke lige hvordan man gør.
Men så er det jo fint at andre kan, det kommer der jo nogle fine makroer ud af.

Kabbak ;-D

Nb. Hvis nu det er et stort regneark, hvor lang tid går det så inden loggen er fuld, skal der gives advarsler om at man skal slette ?

Bak --> der er et problem, hvis man markerer flere celler, kan du overskue hvordan man undgår 'run-time error 13'

Ja, kabbak. Den havde jeg faktisk selv ramt ind i, men det vil gøre koden lidt mere komplex.
Her er den alligevel. :-)
Check venligst om du kan provokere den.......

I det alm. modul:

Type SaveRange
        Val As Variant
        Addr As String
    End Type
   
Public OldSelection() As SaveRange
Public BeforeVal As Variant

Public Sub Hvem(Target)
Dim rng As Range
Dim A As String
Dim C As String
Dim i As Long
Dim cell As Range
A = ActiveSheet.Name
C = Target.Address
i = 0
For Each cell In Target
  i = i + 1
  Set rng = Sheets("Log").Range("A65536").End(xlUp).Offset(1, 0)
  rng.Value = Now
  rng.Offset(0, 1) = A
  rng.Offset(0, 2) = cell.Address
  rng.Offset(0, 3) = "'" & OldSelection(i).Val
  rng.Offset(0, 4) = "'" & cell.Formula
  rng.Offset(0, 5) = Application.UserName
Next
End Sub

I arket eget modul:

Private Sub Worksheet_Change(ByVal Target As Range)
Call Hvem(Target)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim cell As Range
If TypeName(Target) <> "Range" Then Exit Sub
ReDim OldSelection(Target.Count)
i = 0
    For Each cell In Target
        i = i + 1
        OldSelection(i).Val = cell.Formula
    Next cell

End Sub

Hej  bak

Jeg havde også lavet noget lignende,Men droppede det igen, da jeg ikke kunne styre OldSelection.

1.
Hvis du markere et område og vælg kopier, klik ind på en tom celle og sæt ind, så får du fejl, fordi OldSelection kun indeholder den celle du klikkede ind i.
2.
Hvis du markere et område, med værdier og trækker den udad, så er både gammel og nyværdi den samme.

Ok, tak  kabbak, det må der jo så arbejdes videre på :-))

Lukketid.

Hep hey - GENIALT logningsprogramel i har fikset der!!
...har i fundet en løsning på Styringen af OldSelection, således man ikke får disse fejl, når man copy/paste'er ?  (jeg skal nemlig kunne paste flere celler af gangen, men får fejl)

luk