Przejdź do głównej zawartości

Jak automatycznie wypełnić datę w komórce, gdy sąsiednia komórka jest aktualizowana w programie Excel?

Czasami podczas aktualizowania komórki w określonej kolumnie możesz chcieć zaznaczyć ostatnią datę aktualizacji. W tym artykule zalecimy metodę VBA w celu rozwiązania tego problemu. Po zaktualizowaniu komórki sąsiednia komórka zostanie natychmiast automatycznie wypełniona bieżącą datą.

Automatycznie wypełnij bieżącą datę w komórce, gdy sąsiednia komórka zostanie zaktualizowana kodem VBA

Automatycznie wypełnij bieżącą datę w komórce, gdy sąsiednia komórka zostanie zaktualizowana kodem VBA

Przypuśćmy, że dane, które chcesz zaktualizować, znajdują się w kolumnie B, a po zaktualizowaniu komórki w kolumnie B bieżąca data zostanie wypełniona w sąsiedniej komórce kolumny A. Zobacz zrzut ekranu:

Możesz uruchomić następujący kod VBA, aby rozwiązać ten problem.

1. Kliknij prawym przyciskiem myszy kartę arkusza, dla którego chcesz automatycznie wypełnić datę na podstawie sąsiedniej zaktualizowanej komórki, a następnie kliknij Wyświetl kod z menu po kliknięciu prawym przyciskiem myszy.

2. W oknie Microsoft Visual Basic for Applications skopiuj i wklej poniższy kod VBA do okna Code.

Kod VBA: automatycznie wypełnij bieżącą datę w komórce, gdy sąsiednia komórka zostanie zaktualizowana

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

Uwagi:

1). W kodzie B: B oznacza, że ​​zaktualizowane dane znajdują się w kolumnie B.
2). -1 oznacza, że ​​bieżąca data zostanie wypełniona w lewej kolumnie kolumny B. Jeśli chcesz, aby bieżąca data została wypełniona w kolumnie C, zmień -1 na 1.

3. naciśnij inny + Q klucze w tym samym czasie, aby zamknąć Microsoft Visual Basic for Applications okno.

Odtąd podczas aktualizowania komórek w kolumnie B sąsiednia komórka w kolumnie A zostanie natychmiast wypełniona bieżącą datą. Zobacz zrzut ekranu:

Podobne artykuły:

Najlepsze narzędzia biurowe

🤖 Pomocnik AI Kutools: Zrewolucjonizuj analizę danych w oparciu o: Inteligentne wykonanie   |  Wygeneruj kod  |  Twórz niestandardowe formuły  |  Analizuj dane i generuj wykresy  |  Wywołaj funkcje Kutools...
Popularne funkcje: Znajdź, wyróżnij lub zidentyfikuj duplikaty   |  Usuń puste wiersze   |  Łącz kolumny lub komórki bez utraty danych   |   Okrągły bez wzoru ...
Super wyszukiwanie: Wiele kryteriów VLookup  |   Wiele wartości VLookup  |   Przeglądanie pionowe na wielu arkuszach   |   Wyszukiwanie rozmyte ....
Zaawansowana lista rozwijana: Szybko twórz listę rozwijaną   |  Zależna lista rozwijana   |  Lista rozwijana wielokrotnego wyboru ....
Menedżer kolumn: Dodaj określoną liczbę kolumn  |  Przesuń kolumny  |  Przełącz stan widoczności ukrytych kolumn  |  Porównaj zakresy i kolumny ...
Polecane funkcje: Fokus siatki   |  Widok projektu   |   Duży pasek formuły   |  Menedżer skoroszytów i arkuszy   |  Biblioteka zasobów (Automatyczny tekst)   |  Selektor dat   |  Połącz arkusze   |  Szyfruj/odszyfruj komórki   |  Wysyłaj e-maile według listy   |  Super filtr   |   Specjalny filtr (filtruj pogrubienie/kursywa/przekreślenie...) ...
15 najlepszych zestawów narzędzi:  12 Tekst Tools (Dodaj tekst, Usuń znaki, ...)   |   50 + Wykres rodzaje (Wykres Gantta, ...)   |   40+ Praktyczne Wzory (Oblicz wiek na podstawie urodzin, ...)   |   19 Wprowadzenie Tools (Wstaw kod QR, Wstaw obraz ze ścieżki, ...)   |   12 Konwersja Tools (Liczby na słowa, Przeliczanie walut, ...)   |   7 Połącz i podziel Tools (Zaawansowane wiersze łączenia, Podział komórki, ...)   |   ... i więcej

Zwiększ swoje umiejętności Excela dzięki Kutools for Excel i doświadcz wydajności jak nigdy dotąd. Kutools dla programu Excel oferuje ponad 300 zaawansowanych funkcji zwiększających produktywność i oszczędzających czas.  Kliknij tutaj, aby uzyskać funkcję, której najbardziej potrzebujesz...

Opis

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
Comments (51)
No ratings yet. Be the first to rate!
Emilia
Emilia
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?
Reply
0
0
Tim Foolery
Tim Foolery
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!
Reply
Report
0
0
crystal
crystal     Tim Foolery
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
Reply
Report
0
0
L.P
L.P
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
Reply
Report
0
0
crystal
crystal     L.P
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
Reply
Report
0
0
Alexis
Alexis
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!
Reply
0
0
crystal
crystal     Alexis
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?
Reply
Report
0
0
Alexis
Alexis     crystal
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
Reply
0
0
crystal
crystal     Alexis
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
Reply
Report
0
0
Alexis
Alexis     crystal
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..
Reply
0
0
crystal
crystal     Alexis
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.
Report
0
0
crystal
crystal
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
Reply
Report
0
0
DInh
DInh
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
Reply
0
0
crystal
crystal     DInh
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
Reply
Report
0
0
Jacinta
Jacinta
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!
Reply
0
0
Matt
Matt
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?  
Reply
0
0
crystal
crystal     Matt
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?
Reply
Report
0
0
Lucas
Lucas
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
Reply
0
0
chapo
chapo
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.
View Attachments (1 / 5)
Reply
Report
0
0
crystal
crystal     chapo
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
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations