Jump to content

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


gvarth
 Share

Recommended Posts

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

 

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

 

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

Link to comment
Share on other sites

Καλημέρα

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

Και όταν άρχισα να βγάζω άκρη, θυμήθηκα μια αρχή του προγραμματισμού, τα λεγόμενα 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 by apostolos55
  • Upvote 1
Link to comment
Share on other sites

>
' 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 by apostolos55
Link to comment
Share on other sites

  • 1 month later...

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

 

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

το Α και Β

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

 

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

 

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

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

Edited by st2
Link to comment
Share on other sites

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

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

Link to comment
Share on other sites

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

 

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

Link to comment
Share on other sites

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

αλλα

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

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

 

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

 

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

 

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

 

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

Edited by st2
Link to comment
Share on other sites

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

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

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

  • Upvote 1
Link to comment
Share on other sites

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

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

 

>
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

  • Upvote 2
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.