Jump to content

excel καθορισμός έτους


Recommended Posts

 

Ήθελα μία βοήθεια στο excel.

Ας πούμε ότι έχω καθορίσει μία στήλη να γράφει τις ημηρομηνίες ως εξής (παραθέτω 5 γραμμές σε αυτή τη στήλη):

 

10/01/2021
15/01/2021
25/01/2021
10/02/2021
11/02/2021

 

Αυτή τη στιγμή, όταν γράφω π.χ για την πρώτη γραμμή 10/1, και πατήσω Enter, το γράφει ολόκληρο 10/01/2021.

 

Αυτό που θέλω να κάνω, είναι να μου γράφει για έτος το 2020. π.χ. γράφοντας σε αυτή τη στήλη 10/01 και πατώντας Enter, να γράφεται αυτόματα 10/01/2020. Να με γυρνάει ένα χρόνο πίσω. Να μη χρειάζεται να πληκτρολογήσω ολόκληρη την ημερομηνία με το 2020.

 

Πώς θα μπορούσα να το κάνω αυτό, χωρίς να αλλάξω ημερομηνία συστήματος; Μέσα από το Excel.

Link to post
Share on other sites

Και γιατι να μη γραφει 10/01/2019, εννοω πού να ξερει οτι θες το 2020, αν δεν το γραψεις?

Link to post
Share on other sites

Εισαγωγή του Κώδικα (copy/paste) σε ένα Module
 

Sub ApplicationActivateEvents()
   
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   
End Sub

 

Εισαγωγή του Κώδικα (copy/paste) στο Worksheet που γίνεται η εισαγωγή. 

 

 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim AC_Value As Date
Dim Datev As Variant

On Error GoTo Exit_Sub

AC_Row = ActiveCell.Row
AC_Column = ActiveCell.Column
AC_Value = Cells(ActiveCell.Row - 1, ActiveCell.Column)
Datev = AC_Value

On Error GoTo 0

Input_Col = 3
Input_Row1 = 4
Input_Row2 = 10

Application.ScreenUpdating = False
Application.EnableEvents = False

Do While Target.Column = Input_Col
   Do While Target.Row >= Input_Row1 And Target.Row <= Input_Row2
     
     On Error Resume Next
     Cells(AC_Row - 1, AC_Column).NumberFormat = "dd/mm/yyyy"
     On Error Resume Next
     
     If DatePart("m", Datev) <= 2 Then
            Cells(AC_Row - 1, AC_Column) = DateValue(AC_Value) - 366
        Else
            Cells(AC_Row - 1, AC_Column) = DateValue(AC_Value) - 365
     End If
     
     Application.ScreenUpdating = True
     Application.EnableEvents = True
     Exit Sub
   
   Loop
 Exit Sub
Loop

Exit_Sub:
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

 

Η εισαγωγή (ημερομηνίες)  γίνεται στα κελιά C4 έως C10, στο Macro αλλάζεις τις μεταβλητές Ιnput κατά το δοκούν.

 

Input_Col = 3
Input_Row1 = 4
Input_Row2 = 10

 

Το  Workbook πρέπει να  γίνει Save As Excel Binary Workbook (*.xlsb) για να λειτουργούν οι Μακροντολές.

 

Edited by IOANNISTSA
  • Like 1
Link to post
Share on other sites
16 hours ago, serpico75 said:

 

Ήθελα μία βοήθεια στο excel.

Ας πούμε ότι έχω καθορίσει μία στήλη να γράφει τις ημηρομηνίες ως εξής (παραθέτω 5 γραμμές σε αυτή τη στήλη):

 

10/01/2021
15/01/2021
25/01/2021
10/02/2021
11/02/2021

 

Αυτή τη στιγμή, όταν γράφω π.χ για την πρώτη γραμμή 10/1, και πατήσω Enter, το γράφει ολόκληρο 10/01/2021.

 

Αυτό που θέλω να κάνω, είναι να μου γράφει για έτος το 2020. π.χ. γράφοντας σε αυτή τη στήλη 10/01 και πατώντας Enter, να γράφεται αυτόματα 10/01/2020. Να με γυρνάει ένα χρόνο πίσω. Να μη χρειάζεται να πληκτρολογήσω ολόκληρη την ημερομηνία με το 2020.

 

Πώς θα μπορούσα να το κάνω αυτό, χωρίς να αλλάξω ημερομηνία συστήματος; Μέσα από το Excel.

δύο στήλες;

Image2.jpg.309bfbf1b5fe667a05189d8dc0af187b.jpg

  • Like 4
Link to post
Share on other sites

Ευχαριστώ για τις απαντήσεις, και με καλύψατε πλήρως. Ακριβώς αυτό που ήθελα. Έδωσαν στις απαντήσεις τους @Oric και @IOANNISTSA. Το είχα σκεφτεί και δοκιμάσει και γω. Απλά δεν μου δούλεψε διότι δεν έβαζα το 2020 σε εισαγωγικά. Δηλαδή:

 

αντί dd/mm/"2020" (σωστό) έβαζα mm/dd/2020 (δεν δουλεύει).

 

Αυτό ακριβώς ήθελα.

 

Επίσης, το δούλεψα ως εξής (όπως δείχνει ο @tassoss).

Ας πούμε ότι στη στήλη A έχω τις ημερομηνίες με 2021. Έκανα τις καταχωρήσεις, λοιπόν, με 2021 στην Α.

Στην Β, είχα φτιάξει τον τύπο π.χ. για την πρώτη γραμμή =DATE(YEAR(A1)-1; MONTH(A1); DAY(A1)) (είχα φτιάξει και πώς θέλω να φαίνονται οι ημηρομηνίες - άλλο ο τύπος άλλο η προβολή)

Ετσι στην B, ερχόντουσαν οι ημερομηνίες με 2020 με βάση τον τύπο.

Εάν ήθελε κάποιος να έχει τις ημερομηνίες με το 2020 όχι με τον τύπο, αλλά με τις τιμές-ημερομηνίες, σε μία άλλη στήλη π.χ. στην C, πάει και κάνει copy την στήλη B, και στην C κάνει paste values.

 

@tassoss Το δοκίμασα ακριβώς όπως το δείχνεις στη φωτό και χτυπάει λάθος μήνυμα στο Excel. Σίγουρα δε σου χτυπάει error? Μήπως δίνεις κάτι λάθος?

 

Σας ευχαριστώ !

 

 

Edited by serpico75
  • Like 2
Link to post
Share on other sites

Δοκίμασα το Function EDATE του  @tassoss και λειτουργεί, το ενσωμάτωσα και στο Macro σαν Application.WorksheetFunction και λειτουργεί καλύτερα απο την αφαίρεση ημερών ανεξαρτήτως έτους.

 

Εάν θέλεις η αλλαγή να γίνεται στο κελί εισαγωγής και η ημερομηνία (οπτικά) και η τιμή κελιού να είναι ίδια μόνο με Macro υπάρχει λύση. 

 

 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim AC_Value As Date
Dim Datev As Variant

On Error GoTo Exit_Sub

AC_Row = ActiveCell.Row
AC_Column = ActiveCell.Column
AC_Value = Cells(ActiveCell.Row - 1, ActiveCell.Column)
Datev = AC_Value

On Error GoTo 0

Input_Col = 3
Input_Row1 = 4
Input_Row2 = 10

Application.ScreenUpdating = False
Application.EnableEvents = False

Do While Target.Column = Input_Col
   Do While Target.Row >= Input_Row1 And Target.Row <= Input_Row2
     
     On Error Resume Next
     Cells(AC_Row - 1, AC_Column).NumberFormat = "dd/mm/yyyy"
         
     Cells(AC_Row - 1, AC_Column).Formula = Application.WorksheetFunction.EDate(Datev, -12)
            
     Exit Do
   Loop
 Exit Do
Loop

Exit_Sub:

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

 

 

 

 

 

 

  • Like 1
Link to post
Share on other sites

@IOANNISTSA Δεν ξέρω μήπως του @tassoss δε μου δουλεύει, λόγω του ότι δουλεύω σε Excel 2003. Αν και δε νομίζω να είναι αυτό.

Edited by serpico75
Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...

Important Information

By using this site, you agree to our Terms of Use.