Ugrás a tartalomra

Hogyan lehet automatikusan feltölteni a dátumot a cellában, amikor a szomszédos cella frissül az Excelben?

Előfordulhat, hogy egy adott oszlop cellájának frissítésekor érdemes megjelölni a frissítés legújabb dátumát. Ez a cikk egy VBA-módszert javasol a probléma megoldására. A cella frissítésekor a szomszédos cella automatikusan kitöltésre kerül az aktuális dátummal.

Az aktuális dátum automatikus feltöltése a cellában, amikor a szomszédos cella frissül VBA kóddal

Az aktuális dátum automatikus feltöltése a cellában, amikor a szomszédos cella frissül VBA kóddal

Ha feltételezzük, hogy a frissítéshez szükséges adatokat a B oszlopban találja meg, és amikor a B oszlop cellája frissül, az aktuális dátum az A oszlop szomszédos cellájában jelenik meg. Lásd a képernyőképet:

A probléma megoldásához a következő VBA kódot futtathatja.

1. Kattintson a jobb gombbal a lapfülre, amelyhez a szomszédos frissített cella alapján automatikusan be kell töltenie a dátumot, majd kattintson a gombra Kód megtekintése a jobb egérgombbal kattintva.

2. A Microsoft Visual Basic for Applications ablakban másolja és illessze be az alábbi VBA kódot a Kód ablakba.

VBA kód: automatikusan feltölti az aktuális dátumot egy cellában, amikor a szomszédos cella frissül

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

Megjegyzések:

1). A kódban a B: B azt jelenti, hogy a frissített adatok a B oszlopban találhatók.
2). -1 azt jelzi, hogy az aktuális dátum a B oszlop bal egyik oszlopában kerül feltöltésre. Ha azt szeretné, hogy az aktuális dátum feltöltődjön a C oszlopba, kérjük, változtassa meg a -1 értéket 1-re.

3. nyomja meg más + Q gombokat egyidejűleg a Microsoft Visual Basic for Applications ablak.

Mostantól a B oszlop celláinak frissítésekor az A oszlop szomszédos cellája azonnal feltölti az aktuális dátumot. Lásd a képernyőképet:

Kapcsolódó cikkek:

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

🤖 Kutools AI Aide: Forradalmasítsa az adatelemzést a következők alapján: Intelligens végrehajtás   |  Kód létrehozása  |  Hozzon létre egyéni képleteket  |  Adatok elemzése és diagramok létrehozása  |  A Kutools funkciók meghívása...
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észlet:  12 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...

Leírás

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 (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