Բաց թողնել հիմնական բովանդակությունը

Ինչպե՞ս ավտոմատ կերպով լրացնել ամսաթիվը բջիջում, երբ հարակից բջիջը թարմացվում է Excel- ում:

Երբեմն, որոշակի սյունակում բջիջը թարմացնելիս, գուցե ցանկանաք նշել թարմացման մասին վերջին ամսաթիվը: Այս հոդվածը խորհուրդ կտա VBA մեթոդ լուծել այս խնդիրը: Երբ բջիջը թարմացվում է, հարակից բջիջը ավտոմատ կերպով բնակեցվում է ընթացիկ ամսաթվով:

Ավտոմատ լրացրեք ընթացիկ ամսաթիվը բջիջում, երբ հարակից բջիջը թարմացվում է VBA կոդով


Ավտոմատ լրացրեք ընթացիկ ամսաթիվը բջիջում, երբ հարակից բջիջը թարմացվում է VBA կոդով

Ենթադրելով, որ անհրաժեշտ տվյալները տեղակայելու համար անհրաժեշտ տվյալները տեղակայված են B սյունակում, և երբ B սյունի բջիջը թարմացվի, ընթացիկ ամսաթիվը կլրացվի Ա սյունակի հարակից վանդակում: Տեսեք,

Այս խնդիրը լուծելու համար կարող եք գործարկել հետևյալ VBA կոդը:

1. Աջ կտտացրեք թերթիկի ներդիրին, որը դուք պետք է ավտոմատ կերպով լրացնեք ամսաթիվը ՝ հիմնվելով հարակից նորացված բջիջի վրա, ապա կտտացրեք Դիտել կոդը աջ կտտացնելու ցանկից:

2. Microsoft Visual Basic ationsրագրերի համար պատուհանում խնդրում ենք պատճենել և կպցնել ներքևի VBA կոդը օրենսգրքի պատուհանում:

VBA կոդ. Հարակից բջիջը թարմացնելիս բջիջում ավտոմատ լրացնում է ընթացիկ ամսաթիվը

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
            Target.Offset(0, -1) = Date
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                xCell.Offset(0, -1) = Date
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub

Notes:

1) Կոդում B: B նշանակում է, որ նորացված տվյալները տեղակայվում են B սյունակում:
2) -1-ը նշում է, որ ընթացիկ ամսաթիվը լրացված կլինի B սյունակի ձախ մեկ սյունակում: Եթե ուզում եք, որ ընթացիկ ամսաթիվը լրացվի սյունակում C, խնդրում ենք փոխել -1-ը 1-ի:

3. Մամուլ ալտ + Q ստեղները միևնույն ժամանակ փակելու համար Microsoft Visual Basic հավելվածների համար պատուհան.

Այսուհետ, B սյունակում բջիջները թարմացնելիս, A սյունակի հարակից բջիջը անմիջապես կլրացվի ընթացիկ ամսաթվով: Տեսեք,


Առնչվող հոդվածներ քանակը:

Գրասենյակի արտադրողականության լավագույն գործիքները

🤖 Kutools AI օգնականՀեղափոխություն կատարել տվյալների վերլուծության հիման վրա՝ Խելացի կատարում   |  Ստեղծեք ծածկագիր  |  Ստեղծեք հատուկ բանաձևեր  |  Վերլուծել տվյալները և ստեղծել գծապատկերներ  |  Invoke Kutools-ի գործառույթները...
Հանրաճանաչ հատկություններ: Գտեք, ընդգծեք կամ նույնականացրեք կրկնօրինակները   |  Deleteնջել դատարկ շարքերը   |  Միավորել սյունակները կամ բջիջները՝ առանց տվյալների կորստի   |   Կլոր առանց բանաձևի ...
Super Փնտրել: Բազմաթիվ չափանիշների VLookup    Բազմակի արժեք VLookup  |   VLookup բազմաթիվ թերթերում   |   Fuzzy Փնտրել ....
Ընդլայնված բացվող ցուցակ: Արագ ստեղծեք բացվող ցուցակը   |  Կախված բացվող ցուցակ   |  Բազմակի ընտրություն Drop Down ցուցակ ....
Սյունակի կառավարիչ: Ավելացրեք որոշակի քանակությամբ սյունակներ  |  Տեղափոխել սյունակները  |  Փոխարկել թաքնված սյունակների տեսանելիության կարգավիճակը  |  Համեմատեք միջակայքերը և սյունակները ...
Առանձնահատկություններ: Ցանցի կենտրոնացում   |  Դիզայնի տեսք   |   Մեծ Formula Bar    Աշխատանքային գրքույկի և թերթիկների կառավարիչ   |  Ռեսուրսների գրադարան (Ավտոմատ տեքստ)   |  Ամսաթիվ ընտրող   |  Միավորել աշխատանքային թերթերը   |  Գաղտնագրել/գաղտնազերծել բջիջները    Ուղարկեք նամակներ ըստ ցանկի   |  Սուպեր զտիչ   |   Հատուկ զտիչ (զտել թավ/շեղ/շեղված...) ...
Լավագույն 15 գործիքների հավաքածու12 Տեքստ Գործիքներ (Ավելացրեք տեքստ, Հեռացնել նիշերը, ...)   |   50+ Աղյուսակ Տեսակներ (Գանտի աղյուսակը, ...)   |   40+ Գործնական Բանաձեւեր (Հաշվարկել տարիքը ՝ ելնելով ծննդյան տարեդարձից, ...)   |   19 միացում Գործիքներ (Տեղադրեք QR կոդ, Տեղադրեք նկար ուղուց, ...)   |   12 Փոխարկում Գործիքներ (Բառեր համարներ, Արտարժույթի փոխակերպումը, ...)   |   7 Միաձուլում և պառակտում Գործիքներ (Ընդլայնված կոմբինատ տողեր, Պառակտված բջիջներ, ...)   |   ... եւ ավելին

Լրացրեք ձեր Excel-ի հմտությունները Kutools-ի հետ Excel-ի համար և փորձեք արդյունավետությունը, ինչպես երբեք: Kutools-ը Excel-ի համար առաջարկում է ավելի քան 300 առաջադեմ առանձնահատկություններ՝ արտադրողականությունը բարձրացնելու և ժամանակ խնայելու համար:  Սեղմեք այստեղ՝ Ձեզ ամենաշատ անհրաժեշտ հատկանիշը ստանալու համար...

Նկարագրություն


Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
Comments (51)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello,
but what IF i want to Change more than value in column B. I Have data From A to L and I want if anyone make changes than in M and N the user and date will automatedly be adedd? Can you help with that?
This comment was minimized by the moderator on the site
This is working great but is there a way to make it so it only prefills the date if the date cell was empty?

For instance, when somebody goes back and updates the cell which triggers the date to be populated, it updates the old date to today's. I'm trying to make it so it only runs if the date cell is blank.

Thanks!
This comment was minimized by the moderator on the site
Hi Tim,
The following VBA code can help you solve this problem. The current date will only be added to cells in column A if the cell is empty when an update to the corresponding cell in column B is made.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20230721
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then
            If Target.Offset(0, -1).Value = "" Then
                Target.Offset(0, -1).Value = Date
            End If
        End If
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                If xCell.Offset(0, -1).Value = "" Then
                    xCell.Offset(0, -1).Value = Date
                End If
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub
This comment was minimized by the moderator on the site
Hi, Crystal.

This code works perfectly for me with modifications, however, I want to clear the cell if I clear the target. For example, Target Cells change, date and User name populates. GREAT!

BUT, Target Cell is cleared (deleted, " ", or changed to blank) then date and username clears.

Any Ideas?

Here is my current code that works (half way);

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim xRg As Range, xCell As Range
On Error Resume Next

If (Target.Count = 1) Then

If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
Target.Offset(0, 3) = Environ("USERNAME")

If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
Target.Offset(0, 4) = Date

Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))

If (Not xRg Is Nothing) Then
For Each xCell In xRg
xCell.Offset(0, 3) = Environ("USERNAME")
xCell.Offset(0, 4) = Date
Next
End If
Application.EnableEvents = True

End If

End Sub
This comment was minimized by the moderator on the site
Hi Leaven Phillips,
The following VBA code can help you solve the problem. Please give it try.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2023/4/14
    Dim xRg As Range, xCell As Range
    On Error Resume Next

    If Target.Count = 1 Then
        If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then
            If Target.Value = "" Then ' Check if cell in column B is cleared
                Target.Offset(0, 3).ClearContents ' Clear contents of column E
                Target.Offset(0, 4).ClearContents ' Clear contents of column F
            Else ' If cell in column B is not cleared
                Target.Offset(0, 3) = Environ("USERNAME") ' Write username to column E
                Target.Offset(0, 4) = Date ' Write current date to column F
            End If
        End If
        
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
        
        If Not xRg Is Nothing Then
            For Each xCell In xRg
                If xCell.Offset(0, -3).Value = "" Then ' Check if cell in column B is cleared
                    xCell.Offset(0, 3).ClearContents ' Clear contents of column E
                    xCell.Offset(0, 4).ClearContents ' Clear contents of column F
                Else ' If cell in column B is not cleared
                    xCell.Offset(0, 3) = Environ("USERNAME") ' Write username to column E
                    xCell.Offset(0, 4) = Date ' Write current date to column F
                End If
            Next
        End If
        
        Application.EnableEvents = True
    End If
End Sub
This comment was minimized by the moderator on the site
Hi, I'm looking for a time stamp in F2 when a specific status is input into E2, and have G2 time stamped when E2 is updated to new specific status has been entered but not change the time stamp in F2. Is that possible?

Thank you!
This comment was minimized by the moderator on the site
Hi Alexis,
I don't quite understand your question.
What are the two specific status you mentioned above?Do you mean that when a specific value (for example A) is entered in E2, a timestamp is inserted in F2? When another specific value (for example B) is entered in E2, a timestamp is inserted in G2? If you enter a value other than the two specified values in E2, there is no change.
Can you upload a screenshot of your data?
This comment was minimized by the moderator on the site
Example.. I send an email to my boss to get approval on a project. I input that info into my sheet on E2, the time stamp for that status would be on F2. Next day my boss approves project and I update status from pending approval to approved in cell E2. Once its been updated I would like a new time stamp from that input onto G2. Is that possible?

Thank you
This comment was minimized by the moderator on the site
Hi Alexis,
The following VBA code can do you a favor. Please give it a try. Thank you.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221028
 Dim xRg As Range
    On Error Resume Next
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If
    Set xRg = Intersect(Range("E2"), Target)
    If xRg Is Nothing Then
        Exit Sub
    End If
    If Target.Value = "panding approval" Then
        Target.Offset(0, 1) = Date
        Application.EnableEvents = False
    ElseIf Target.Value = "approved" Then
        Target.Offset(0, 2) = Date
    End If
    Application.EnableEvents = True
End Sub
This comment was minimized by the moderator on the site
Hi Crystal,

I copied this to the sheet and it didn't create the times. Do I need to have the formula in the cells before I can add the code? It wont let me paste the shot of the sheet..
This comment was minimized by the moderator on the site
Hi Alexis,
Right click the sheet tab, select View Code from the right-clicking menu and copy the code into the Sheet (Code) window. Save the code and press the Alt + Q keys to close the Microsoft Visual Basic for Applications window.
When you enter "panding approval" in E2, the current time will be automatically entered in F2, and when you enter "approved" in E2, the current time will be automatically entered in G2.
This comment was minimized by the moderator on the site
Hi Dlnh,
The following VBA code can do you a favor. Please give it a try. Hope I can help.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/6/10
    On Error Resume Next
    
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Value = "yes" Then
        Target.Offset(0, 1) = Date
    End If
End Sub
This comment was minimized by the moderator on the site
Dear,
please help if is there a way to auto input the date to column B once the specific data input to in column A ? for a sample if I put "yes" to a cell in column A, the date will be inputted to column B and if I put " No", it won't be changed in Column B
This comment was minimized by the moderator on the site
Hi Dlnh,
The following VBA code can do you a favor. Please give it a try. Hope I can help.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/6/10
    On Error Resume Next
    
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Value = "yes" Then
        Target.Offset(0, 1) = Date
    End If
End Sub
This comment was minimized by the moderator on the site
Hi is there a way to modify the code such that when I copy and paste values into column B, column A still auto-populates through VBA?

Also, when I delete data in a row in column B, the date still shows in column A. How do I modify the formula such that if column B is empty in the same row, then the date will also disappear when data is deleted, rather than having to manually delete it. Many thanks!
This comment was minimized by the moderator on the site
Hello, this formula works great.  However, is there a way to set it that it only updates the cell in column A if it is empty?  
This comment was minimized by the moderator on the site
Hi Matt,Sorry, I don't quite understand what you mean. Can you try to be more specific about your question, or provide a screenshot of what you are trying to do?
This comment was minimized by the moderator on the site
Hi, I am using your code as a reference. I want to ask if it is possible to have the following:1. Prevent duplicated date entries2. Have the 2 macro inputs at the same time : Target.Offset(0,-1), Target,Offset(0,1)3. Possible to auto insert an image to the cell?
Was trying to figure it out myself but i can't seem to find any resources online which can help me
This comment was minimized by the moderator on the site
I'm inputting this code into my excel workbook and nothing is happening. Could anyone please help? Ideally, I would like when something is put into column A, time would be put into column B.
This comment was minimized by the moderator on the site
Hi chapo,Try the below code. Hope I can help.<div data-tag="code">Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2020/10/12
Dim xRg As Range, xCell As Range
On Error Resume Next
If (Target.Count = 1) Then
If (Not Application.Intersect(Target, Me.Range("A:A")) Is Nothing) Then _
Target.Offset(0, 1) = Time
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("A:A"))
If (Not xRg Is Nothing) Then
For Each xCell In xRg
xCell.Offset(0, 1) = Time
Next
End If
Application.EnableEvents = True
End If
End Sub
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations