[Γενικά] μετατροπή σε ωρα

[Tasos]

Καλησπέρα σε όλους!

Νίκο, ο Γιώργος έχει δίκιο. Δεν γίνεται με κάποια μορφοποίηση κελιού να μετατρέψουμε το
1245 σε 12:45 και να μπορεί ταυτόχρονα να υπολογιστεί για να βγεί κάποιο άθροισμα κτλ.

Με τη βοήθεια της VBA και με μια μικρή προετοιμασία στο φύλλο θα μπορέσουμε να εμφανίζουμε την ώρα σε μορφή "ωω:λλ" σε μορφή κειμένου η οποία μπορεί να υπολογιστεί από την Excel σαν αριθμός ή ώρα!

1) Μορφοποίησε τις στήλες που θα πληκτρολογείται η ώρα ως κείμενο (Επιλογή στήλης και συνδυασμος πλήκτρων CTRL+1).

xl_format_dlg.jpg

2) στην πρώτη γραμμή των στηλών που θα πληκτρολογείται η ώρα (πχ. στο κελί C1, D1, F1 κοκ.) να πληκτρολογήσεις την τιμή -1.
Έτσι, με βάση αυτή την τιμή, ο κώδικας παρακάτω θα μπορεί να ελέγξει αν προκειται για στήλη που πρέπει να γίνουν οι απαραίτητες αλλαγές.

3) Kανε δεξί κλικ στην καρτέλα του φύλλου και επίλεξε: "Προβολή κώδικα".
Στο παράθυρο που θα εμφανιστεί, επικόλλησε τον παρακάτω κώδικα:

Option Explicit
   
  Private Sub Worksheet_Change(ByVal Target As Range)        ' Target = το κελί που προκαλεί το συμβάν αυτό
      On Error Resume Next
      If Cells(1, Target.Column) <> -1 Then Exit Sub
      If Target.Row > 50 Or Target.Row < 2 Then Exit Sub ' αν η γραμμή του "Target" είναι
            'μεγαλύτερη του 50 ή μικρότερη του  2  τοτε δεν θα συνεχίσει η εκτέλεση του κώδικα.
            'Προσάρμοσε τα νούμερα αυτά στα μέτρα σου.

      If Target.Value = "" Then Exit Sub
      Application.EnableEvents = False
      Select Case Len(Target.Text)
          Case Is > 4
              Target.ClearContents
              Target.Select
              GoTo TheEnd
          Case Is = 4
              If Left(Target, 2) > 24 Or Right(Target, 2) > 59 Then
                  Target.ClearContents
                  Target.Select
                  GoTo TheEnd
              End If
              Target.Value = Left(Target, 2) & ":" & Right(Target, 2)
   
          Case Is = 3
              If Right(Target, 2) > 59 Then
                  Target.ClearContents
                  Target.Select
                  GoTo TheEnd
              End If
              Target.Value = "0" & Left(Target, 1) & ":" & Right(Target, 2)
          Case Is = 2
              If Target.Value > 23 Then
                  Target.ClearContents
                  Target.Select
                  GoTo TheEnd
              End If
              Target.Value = Format(Target, "00") & ":" & "00"
   
          Case Is = 1
              Target.Value = Format(Target.Text, "00") & ":" & "00"
      End Select
      If Target.Value = 0 Then Target.Value = "00:00"
   
  TheEnd:
      Application.EnableEvents = True
  End Sub

Δοκίμασε τον τρόπο λειτουργίας με διαφορες τιμές.

Αν κάπου υπαρχει κάποια απορία... εδώ είμαστε.

Καλη συνέχεια!

Φιλικά

Τάσος