Excel - Για όσους θέλουν να ψάξουν παραπέρα ...

[gvarth]

Την evalmath την είχα γράψει καιρό τώρα εγώ , βασισμένος στην ενσωματωμένη evaluate του excel . Όταν την έγραψα , δούλευα σε laptop με XP PRO και Excel 2003.

 

Το σχετικό download είναι αυτό .

 

Μέσα εκεί έχουν γίνει διάφορες προτάσεις - βελτιώσεις και από σένα και από τον Gousgounis.

[apostolos55]

Καλημέρα

Πρόσφατα μου προέκυψε χειρισμός χρόνου σε VBA ...

Και όταν άρχισα να βγάζω άκρη, θυμήθηκα μια αρχή του προγραμματισμού, τα λεγόμενα Black-Boxes, δηλαδή να ξέρεις τι βάζεις και τι παίρνεις... πάντα. Σε συνδυασμό με την απαίτηση να μην ψάχνω κάθε φορά αν το κελί έχει χρόνο ή κείμενο, ή αν θέλω να προσθέσω μερικά λεπτά με τι διαιρώ κλπ, προέκυψε η Function TimeFromAny([TimeOrHours],[myMins],[mySecs]) As Variant, όπως φαίνεται όλα είναι Optional. Παραθέτω κώδικα και μετά Παραδείγματα:

>
' Time from Any value
' Use Application.WorksheetFunction.IsText to check for text
' The proper way to work with time, since time is Variant!
'
' Creator Apostolos Goulandris - Jan 2013
Function TimeFromAny(Optional TimeOrHours = 0, Optional myMins As Integer = 0, Optional mySecs As Integer = 0) As Variant
Dim a1 As Integer, a2 As Integer, thisTime As Long

If Application.WorksheetFunction.IsText(TimeOrHours) Then
' Time from String
a1 = InStr(TimeOrHours, ":"): a2 = InStr(a1 + 1, TimeOrHours, ":")
thisTime = Left(TimeOrHours, a1 - 1) * 3600 + Mid(TimeOrHours, a1 + 1, a2 - a1 - 1) * 60 + Mid(TimeOrHours, a2 + 1)
TimeFromAny = Round(thisTime / 86400, 6)
ElseIf myMins > 0 Or mySecs > 0 Then
' Time from Values
thisTime = TimeOrHours * 3600 + myMins * 60 + mySecs
TimeFromAny = Round(thisTime / 86400, 6)
Else
' Time from Time
TimeFromAny = TimeOrHours
End If
End Function

 

Παραδείγματα:

με κείμενο: TimeFromAny("02:30:20")

με τιμές: TimeFromAny(2,30,20)

με άλλο χρόνο TimeFromAny(time)

στο Excel με κείμενο =TimeFromAny(A1)

για πρόσθεση 29' στην τρέχουσα ώρα myTime+TimeFromAny(myMins:=29)

για πρόσθεση 1ώρας και 55'' στην τρέχουσα ώρα myTime+TimeFromAny(mySecs:=55,TimeOrHours:=1)

ή το ίδιο γραμμένο αλλιώς myTime+TimeFromAny(1,,55)

κλπ

 

Μην ξεχνάτε ότι το excel και η VBA χειρίζονται το χρόνο σαν Variant (και περιέχει μέρες και χρόνο). Η timeFromAny παράγει το τμήμα του χρόνου μόνο (το δεκαδικό μέρος δηλαδή).

Για προβολή της ώρας σε κατανοητή μορφή, χρησιμοποιείστε την Format, πχ format(TimeFromAny(...),"hh:mm:ss") ή προβάλετε σε φορμαρισμένο κελί (ως time)

Μερική αντιστοιχία με την TimeFromAny για Excel μόνο μπορεί να παραχθεί με =IfError(TimeValue(A1);A1) οπότε αν δεν τα καταφέρει με την TimeValue, παίρνει την τιμή.. φυσικά προσθήκη λεπτών ωρών κλπ είναι άλλη ιστορία

 

keep programming mates

Edited Ιανουάριος 10 , 2013 by apostolos55

[apostolos55]

>
' Time from String
a1 = InStr(TimeOrHours, ":"): a2 = InStr(a1 + 1, TimeOrHours, ":")
thisTime = Left(TimeOrHours, a1 - 1) * 3600 + Mid(TimeOrHours, a1 + 1, a2 - a1 - 1) * 60 + Mid(TimeOrHours, a2 + 1)
TimeFromAny = Round(thisTime / 86400, 6)

 

μόλις έμαθα ότι η TimeValue υπάρχει και στη VBA!!!! οπότε ο παραπάνω κώδικας αλλάζει σε:

>
' Time from String
TimeFromAny = TimeValue(TimeOrHours)

 

τώρα καλύπτονται και κάποιες περιπτώσεις 10:00:01 am/pm ή πμ/μμ δηλαδή οι ώρες σε 12ωρη βάση, ενώ η προηγούμενη εφαρμογή ήθελε 24ωρη βάση.

χαιρετώ

Edited Ιανουάριος 10 , 2013 by apostolos55

[st2]

ρε παιδια να ρωτησω κατι

 

έχω ενα φακελο με 2αρχεια excel

το Α και Β

με πολλα sheets το καθενα

 

στα 2 αυτα αρχεια τα κελια τους τραβανε παρα πολλες εξαρτησεις απο το ενα αρχειο στο αλλο

 

αν το κάνω αντιγραφη - επικόληση σε αλλο σημειο και αν κάνω μετονομασια των αρχειων σε Γ και Δ αντιστοιχα

οι εξαρτησεις των κελιων θα χαλάσουν????

Edited Μάρτιος 6 , 2013 by st2

[Γιάννης]

Αν αλλάξεις φάκελο και τα μετονομάσεις κιόλας είναι πολύ πιθανό να χαθούν οι εξαρτήσεις...

Εγώ επειδή δεν είχα βρει άκρη πότε χάνονται και πότε όχι, σταμάτησα να κάνω εξαρτήσεις από άλλα αρχεία. Όλα σε ένα βιβλίο εργασίας! Γιατί όχι?

[gvarth]

Κι εγώ για να είμαι σίγουρος , εφαρμόζω αυτό που έγραψε ο Γιάννης παραπάνω .

 

Όλα τα φύλλα σε ένα Workbook (όταν είναι εφικτό) και ησυχάζεις από εξαρτήσεις σε εξωτερικά αρχεία . Διαφορετικά , αν δεν προσεχτεί το θέμα , και τα αρχεία μετακινηθούν , χάνεται πολύς χρόνος ...

[st2]

και εγω συμφωνω

αλλα

είναι πολλα τα φύλλα σε καθε αρχειο

δεν μπορω να τα βάλω όλα μαζι

 

απο τις δοκιμες που έκανα

 

ειδα οτι χανονται με την αλλαγη ονομασιας (χαλάει το path)

 

και όχι αν τα εχεις μαζι και τα μετακινεις μαζι

 

θελω αναλογα το εργο να τα μετονομαζω

Edited Μάρτιος 6 , 2013 by st2

[abenetos]

Επειδή έχω αντιμετωπίσει το πρόλημα, έχω διαπιστώσει κι εγώ πως πράγματι σε αντιγραφή έστω και ολόκληρου του φακέλου χαλάει η εξάρτηση.

Πρέπει να μπεις Δεδομένα/επεξεργασία συνδέσεων και να το "ξαναφέρεις" επιλέγοντας ξανά τα σχετικά αρχεία.

Αν δεν έχεις πάρα πολλά αρχεία δεν είναι δύσκολο. Εγώ το δουλεύω έτσι.

[Samdreamth]

Παρακάτω θα βρείτε μια μακροεντολή την οποία όταν την τρέχετε δημιουργέιται μια λίστα με όλες τις αναφορές σε άλλα βιβλία εργασίας. Η λίστα δημιουργείται σε ένα νέο φύλλο του βιβλίου εργασίας (με όνομα Link List).

Ελπίζω να σας χρησιμεύσει...

 

>
Sub ListExternalFormulaReferences()

Dim ws As Worksheet, TargetWS As Worksheet, SourceWB As Workbook

If ActiveWorkbook Is Nothing Then Exit Sub

Application.ScreenUpdating = False

With ActiveWorkbook
 On Error Resume Next
 Set TargetWS = .Worksheets.Add(Before:=.Worksheets(1))
 If TargetWS Is Nothing Then ' the workbook is protected
	 Set SourceWB = ActiveWorkbook
	 Set TargetWS = Workbooks.Add.Worksheets(1)
	 SourceWB.Activate
	 Set SourceWB = Nothing
 End If
 With TargetWS
	 .Range("A1").Formula = "Sequence"
	 .Range("B1").Formula = "Cell"
	 .Range("C1").Formula = "Formula"
	 .Range("A1:C1").Font.Bold = True
 End With
 For Each ws In .Worksheets
	 If Not ws Is TargetWS Then
		 ListLinksInWS ws, TargetWS
	 End If
 Next ws
 Set ws = Nothing
End With
With TargetWS
 .Parent.Activate
 .Activate
 .Columns("A:C").AutoFit
 On Error Resume Next
 .Name = "Link List"
 On Error GoTo 0
End With
Set TargetWS = Nothing

Application.ScreenUpdating = True

End Sub

Sub ListLinksInWS(ws As Worksheet, TargetWS As Worksheet)

Dim cl As Range, cFormula As String, tRow As Long

If ws Is Nothing Then Exit Sub
If TargetWS Is Nothing Then Exit Sub
Application.StatusBar = "Finding external formula references in " & _
 ws.Name & "..."
For Each cl In ws.UsedRange
 cFormula = cl.Formula
 If Len(cFormula) > 0 Then
	 If Left$(cFormula, 1) = "=" Then
		 If InStr(cFormula, "[") > 1 Then
			 With TargetWS
				 tRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
				 .Range("A" & tRow).Formula = tRow - 1
				 .Range("B" & tRow).Formula = ws.Name & "!" & _
					 cl.Address(False, False, xlA1)
				 .Range("C" & tRow).Formula = "'" & cFormula
			 End With
		 End If
	 End If
 End If
Next cl
Set cl = Nothing

Application.StatusBar = False

End Sub

[gvarth]

Χρησιμότατο . Σ' ευχαριστώ .