Ugrás a tartalomra

Hogyan lehet nyomon követni a változásokat a munkafüzet megosztása nélkül?

Normális esetben, amikor a Változások követése funkciót alkalmazza az Excelben, a munkafüzet egyidejűleg meg lesz osztva, ez bosszantó lesz, mert az Excel egyes szolgáltatásait letiltják. Hogyan lehet nyomon követni a változásokat a munkafüzet megosztása nélkül? Itt egy VBA kódot ajánlok neked.

A változtatások nyomon követése a munkafüzet VBA-kóddal történő megosztása nélkül


nyíl kék jobb buborék Szöveg konvertálása táblázattá az Outlookban

Nincs közvetlen módja a probléma megoldására, de a megoldáshoz rugalmas VBA kódot alkalmazhat, kérjük, tegye a következőket:

1. Kattintson a jobb gombbal azon a lapfülön, amelyen nyomon akarja követni a megváltozott cellákat, majd válassza a lehetőséget Kód megtekintése a helyi menüből, a kiugrottban Microsoft Visual Basic for Applications ablakba, kérjük, másolja és illessze be a következő kódot az üresbe Modulok:

VBA kód: Változások követése munkafüzet megosztása nélkül:

Private Sub Worksheet_Change(ByVal Target As Range)
  'Updateby Extendoffice
    Const xRg As String = "A1:Z1000"
    Dim strOld As String
    Dim strNew As String
    Dim strCmt As String
    Dim xLen As Long
    With Target(1)
        If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub
        strNew = .Text
        Application.EnableEvents = False
        Application.Undo
        strOld = .Text
        .Value = strNew
        Application.EnableEvents = True
        strCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & _
        Application.UserName & Chr(10) & "Previous Text :- " & strOld
        If Target(1).Comment Is Nothing Then
            .AddComment
        Else
            xLen = Len(.Comment.Shape.TextFrame.Characters.Text)
        End If
        With .Comment.Shape.TextFrame
            .AutoSize = True
            .Characters(Start:=xLen + 1).Insert IIf(xLen, vbLf, "") & strCmt
        End With
    End With
End Sub

doc pályaváltás megosztás nélkül 1

Megjegyzések: A fenti kódban A1: Z1000 az az adattartomány, amelyet nyomon akar követni.

2. Ezután mentse el és zárja be ezt a kódablakot. Most, amikor megváltoztatja az értékeket a cellában megadott tartományban lévő cellákban, a cellák nyomon követésre kerülnek, és a munkafüzet nem lesz megosztva. Lásd a képernyőképet:

doc pályaváltás megosztás nélkül 2

A legjobb irodai hatékonyságnövelő eszközök

Népszerű szolgáltatások: Ismétlődések keresése, kiemelése vagy azonosítása   |  Üres sorok törlése   |  Oszlopok vagy cellák kombinálása adatvesztés nélkül   |   Kerek Formula nélkül ...
Szuper keresés: Több kritérium VLookup    Többértékű VLookup  |   VLookup több munkalapon   |   Fuzzy Lookup ....
Speciális legördülő lista: Gyors legördülő lista létrehozása   |  Függő legördülő lista   |  Többszörösen válassza ki a legördülő listát ....
Oszlopkezelő: Adjon meg egy adott számú oszlopot  |  Oszlopok mozgatása  |  Kapcsolja be a Rejtett oszlopok láthatósági állapotát  |  Tartományok és oszlopok összehasonlítása ...
Kiemelt funkciók: Rács fókusz   |  Design nézet   |   Nagy Formula bár    Munkafüzet és lapkezelő   |  Erőforrás-könyvtár (Auto szöveg)   |  Dátumválasztó   |  Kombinálja a munkalapokat   |  Cellák titkosítása/dekódolása    E-mailek küldése listánként   |  Szuper szűrő   |   Speciális szűrő (félkövér/dőlt/áthúzott szűrés...) ...
A 15 legjobb eszközkészlet12 szöveg Eszközök (Szöveg hozzáadása, Karakterek eltávolítása,...)   |   50 + Táblázatos Típusai (Gantt-diagram,...)   |   40+ Praktikus képletek (Számolja ki az életkort a születésnap alapján,...)   |   19 beszúrás Eszközök (Helyezze be a QR-kódot, Kép beszúrása az útvonalból,...)   |   12 Átalakítás Eszközök (Számok szavakig, Valuta átváltás,...)   |   7 Egyesítés és felosztás Eszközök (Haladó kombinált sorok, Hasított sejtek,...)   |   ... és több

Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz.  Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...

kte lap 201905


Az Office lap füles felületet hoz az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
Comments (14)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Does this MAcro capture changes on formula values everytime my data model is updated?
This comment was minimized by the moderator on the site
Is there a way to record the changes for all tabs in a workbook, and record the changes to a new spreadsheet? THAT would be awesome ... and I can't find any information across the internet with this type of tracking process.
This comment was minimized by the moderator on the site
Hello, jfjoyner,To change this code for all sheets, and record the track changes to another sheet, please use the below code:
Note: Please put this code into the ThisWorkbook module.
Option Explicit
Dim mStrRgAddress As String
Dim mStrRgValue As String

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const xRg As String = "A1:Z1000"
Const xSheetName As String = "Record sheet" 'The sheet that you want to put the track changes, please change the sheet name to your own.
Dim strOld As String
Dim strNew As String
Dim strCmt As String
Dim xLen As Long
Dim xSheet As Worksheet
Dim xRgCell As Range
Dim xRgCell2 As Range
On Error Resume Next
Set xSheet = Application.Sheets.Item(xSheetName)
If mStrRgAddress <> "" Then
Set xRgCell = Range(mStrRgAddress)
If xRgCell.Text <> mStrRgValue Then
strCmt = mStrRgAddress & " : " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & _
Application.UserName & Chr(10) & "Previous Text :- " & mStrRgValue
Set xRgCell2 = xSheet.Range("a1048576").End(xlUp)
If xRgCell2.AddressLocal = xSheet.Range("A1").AddressLocal Then
If xRgCell2.Value <> "" Then
Set xRgCell2 = xRgCell2.Offset(1, 0)
End If
Else
Set xRgCell2 = xRgCell2.Offset(1, 0)
End If
xRgCell2.Value = strCmt
End If
End If
If xSheet.Name = Sh.Name Then Exit Sub
mStrRgValue = Target.Text
mStrRgAddress = Target.AddressLocal(False, False, , True)
End Sub
This comment was minimized by the moderator on the site
Thanks, this is great, but I can't get it to work. I assume it runs automatically, meaning no need to click on "Run"? I renamed a worksheet to say {--TRACK_CHANGES--} to follow the instructions you left in green. So far, it is not recording anything. Thanks.
This comment was minimized by the moderator on the site
Hello jfjoyner3,First, after you copy our VBA Code into the ThisWorkbook module, the code runs automatically.Second, our VBA code does works. Plesae see the two screenshots I uploaded in this comment.
This comment was minimized by the moderator on the site
Mandyzhou, Thank you again for this detailed guidance. I am getting a Syntax Error and it points me to this line:

If mStrRgAddress <> "" Then

Are you able to guide to modify this and remove the Syntax Error?
Thank you!
This comment was minimized by the moderator on the site
Thanks again, skyyang.I also noticed that when I pasted this into the module for This Workbook, my large spreadsheet began to calculate continuously and would not stop.  I know nothing about VBA programming, but I found this discussion about the same topic. It might explain why the calculation goes on endlessly. https://www.mrexcel.com/board/threads/continuous-calculation-wont-stop.1179541/page-6#posts 
The issue on this web site was: <span style="letter-spacing: 0.2px; color: inherit; font-family: inherit; font-style: inherit; font-variant-ligatures: inherit; font-variant-caps: inherit;">But once the continuous-calculation issue starts, it's persistent. Pressing the Esc key does interrupt the calculation, but it starts right back up again unless I switch to Manual Calc. Manual calc mode works fine until I run any of the macros, which then ends by re-enabling AutoCalc... I've been through each worksheet in the model and run error-checking to no avail.</span>
Their conclusion was: This is true: once you refer to a form object or its property (frmBudget.startupposition = 3) - the object is then loaded until you unload it or reset your project (State loss - At this point ALL variables are reset and any values lost)
This comment was minimized by the moderator on the site
Hello jfjoyner3,How are you. As you can see in the two screenshots, I changed the "record sheet" into "sheet2" in the VBA Code. 
Then I returned to Excel workbook. After I made some changes in the sheet1, all these changes are recorded in the sheet2.
As for the continuous-calculation issue, could you please send us the screenshots or video of your problem? So we can fully understand what is going on here. Thanks! 
Sincerely,Mandy
This comment was minimized by the moderator on the site
MandyZhou, thank you. Does this macro start automatically when I open the spreadsheet? Or must I start it manually? 
The continuous calculation problem is related to another app. 
This comment was minimized by the moderator on the site
Thank you very much!
This comment was minimized by the moderator on the site
Hello jfjoyner3,You are welcome. After you save the spreadsheet with the macro VBA code, the macro will start automatically every time you open the spreadsheet. No need to start it manually. Any question, please feel free to contact us. Have a nice day!Best regards,Mandy   
This comment was minimized by the moderator on the site
I tried using this VBA code in my excel sheet. But it gave me errors. I don't know from where this macro should be called and what is the argument to the function you have provided when it is called.
This comment was minimized by the moderator on the site
Great work. Unfortunately, there are some issues with your code. - It will add a comment even on the first entry of the cell. How can I make it track changes from the second entry not the first one? - Once I enter a value in a cell I can't do "Undo". - It doesn't work with tables. Try to use on a table then try to add or delete a raw and the code will crash. I really wish I have the knowledge to get the code to work the way I want it as described above.
This comment was minimized by the moderator on the site
I have the same issue. "Undo" and "Redo" buttons don't work anymore. Is there any solution for this?
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations