Skip i'r prif gynnwys

Sut i olrhain newidiadau heb rannu llyfr gwaith?

Fel rheol, pan ddefnyddiwch y nodwedd Newidiadau Trac yn Excel, bydd y llyfr gwaith yn cael ei rannu ar yr un pryd, bydd hyn yn annifyr oherwydd bydd rhai o'r nodweddion yn Excel yn anabl. Sut allech chi olrhain newidiadau heb rannu llyfr gwaith? Yma, byddaf yn argymell cod VBA i chi.

Trac newidiadau heb rannu llyfr gwaith â chod VBA


swigen dde glas saeth Trosi testun yn fwrdd yn Outlook

Nid oes unrhyw ffordd uniongyrchol ichi ddatrys y broblem hon, ond, gallwch gymhwyso cod VBA hyblyg i'w ddatrys, gwnewch fel a ganlyn:

1. Cliciwch ar y dde wrth y tab dalen rydych chi am olrhain celloedd sydd wedi newid, a dewis Gweld y Cod o'r ddewislen cyd-destun, yn y popped allan Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, copïwch a gludwch y cod canlynol i'r gwag Modiwlau:

Cod VBA: Trac newidiadau heb rannu llyfr gwaith:

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

newid trac doc heb rannu 1

Nodyn: Yn y cod uchod, A1: Z1000 yw'r ystod ddata rydych chi am olrhain newidiadau.

2. Yna arbedwch a chau ffenestr y cod hwn, nawr, pan fyddwch chi'n newid y gwerthoedd mewn unrhyw gelloedd o fewn yr ystod benodol rydych chi wedi'i gosod yn y cod, bydd y celloedd yn cael eu tracio, ac nid yw'r llyfr gwaith yn cael ei rannu. Gweler y screenshot:

newid trac doc heb rannu 2

Offer Cynhyrchiant Swyddfa Gorau

🤖 Kutools AI Aide: Chwyldro dadansoddi data yn seiliedig ar: Cyflawniad Deallus   |  Cynhyrchu Cod  |  Creu Fformiwlâu Personol  |  Dadansoddi Data a Chynhyrchu Siartiau  |  Invoke Swyddogaethau Kutools...
Nodweddion Poblogaidd: Darganfod, Amlygu neu Adnabod Dyblygiadau   |  Dileu Rhesi Gwag   |  Cyfuno Colofnau neu Gelloedd heb Colli Data   |   Rownd heb Fformiwla ...
Super-edrych: VLookup Meini Prawf Lluosog    VLookup Gwerth Lluosog  |   VLookup Ar Draws Taflenni Lluosog   |   Edrych Niwlog ....
Rhestr gwympo Uwch: Creu Rhestr Gollwng yn Gyflym   |  Rhestr Gollwng Dibynnol   |  Rhestr Gollwng Aml-ddewis ....
Rheolwr Colofn: Ychwanegu Nifer Penodol o Golofnau  |  Symud Colofnau  |  Toglo Statws Gwelededd Colofnau Cudd  |  Cymharwch Ystodau a Cholofnau ...
Nodweddion dan Sylw: Ffocws ar y Grid   |  Golwg Dylunio   |   Bar Fformiwla Mawr    Rheolwr Llyfr Gwaith a Thaflen   |  Llyfrgell Adnoddau (Testun Auto)   |  Dewiswr Dyddiad   |  Cyfuno Taflenni Gwaith   |  Amgryptio/Dadgryptio Celloedd    Anfon E-byst trwy Restr   |  Hidlo Super   |   Hidlo Arbennig (hidlo mewn print trwm/italig/strikethrough...) ...
15 Set Offer Gorau12 Testun offer (Ychwanegu Testun, Dileu Cymeriadau,...)   |   50 + Siart Mathau (Siart Gantt,...)   |   40+ Ymarferol Fformiwlâu (Cyfrifwch oedran yn seiliedig ar ben-blwydd,...)   |   19 mewnosod offer (Mewnosod Cod QR, Mewnosod Llun o'r Llwybr,...)   |   12 Trosi offer (Rhifau i Eiriau, Trosi arian cyfred,...)   |   7 Uno a Hollti offer (Rhesi Cyfuno Uwch, Celloedd Hollt,...)   |   ... a mwy

Supercharge Eich Sgiliau Excel gyda Kutools ar gyfer Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed. Kutools ar gyfer Excel Yn Cynnig Dros 300 o Nodweddion Uwch i Hybu Cynhyrchiant ac Arbed Amser.  Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...

Disgrifiad


Mae Office Tab yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
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