Jump to content

apostolos55

Members
  • Content Count

    70
  • Joined

  • Last visited

  • Days Won

    5

File Comments posted by apostolos55


  1. καλησπέρα

    φίλε Bernidakis και προς όλους τους φίλους στο Michanikos.gr, απλά σας ενημερώνω ότι το εργαλείο δούλεψε πολύ καιρό άψογα, πλέον όμως και το ΙΚΑ έχει ακολουθήσει τις εξελίξεις και ο προσωπικός μου χρόνος δεν μου επιτρέπει να ασχοληθώ με ενημερώσεις κλπ. Μπορεί να έχουν αλλάξει οι προδιαγραφές του ΙΚΑ για τα αποστελλόμενα αρχεία. Δεν γνωρίζω και δεν μπορώ να ασχοληθώ. Ο κώδικας υπάρχει και είναι ανοικτός αν κάποιος άλλος επιθυμεί να ασχοληθεί.

    χαιρετώ

    Απόστολος


  2. Επανέρχομαι με κάτι πολύ παλιό, πολύ κρυμένο... Δεν υπάρχει λόγος να χρησιμοποιούμαι VBA για evaluate! Γίνεται με συνάρτηση του Excel κρυμμένη από το Excel, αλλά υπαρκτή στο RefersTo στα Named Ranges... κουφάθηκα όταν το είδα και διαπίστωσα ότι δουλεύει...

    λεπτομέρειες και εδώ.


  3. If InStr(b, ">") > 0 Then EvalFL = True
    If InStr(b, "<") > 0 Then EvalFL = True

     

    την ανισότητα δεν την χρειαζόμαστε και θα την βγάλω σε επόμενη έκδοση, καθώς μπορούμε να στείλουμε πίνακα με TRUE/FALSE τιμές:

    πχ =getif(C27:C40*7<50;TRUE;;14) θα επιστρέψει τις θέσεις (σχετικές) των δεδομένων που επαληθεύουν τα υπογραμμισμένα...

     

    όποιος έχει ιδέες για βελτίωση ή ανακαλύπτει χρήσεις νέες, μην διστάζετε να τα στέλνετε...


  4. Βάζω τον κώδικα εδώ για να αποφύγουν οι συνάδελφοι και φίλοι το download/insert module κλπ. και να κάνουν τις δοκιμές τους πιο εύκολα.

    Δυο παρακλήσεις ωστόσο:

    1) Διαβάστε τα αρχικά σχόλια και τη περιγραφή πριν από ερωτήσεις, και αν κάτι δεν σας τρέχει κάντε download και δείτε τις εφαρμογές που έχω στο excel

    2) Κατά την αντιγραφή του κώδικα μην σβήσετε τίποτα (πληροφορίες/στοιχεία κλπ) ούτε από τα σχόλια. Το διαθέτω τελείως ελεύθερο προς χρήση και μεταβολή αλλά με την υποχρέωση να διατηρείτε και να ενημερώνετε με τις αλλαγές σας τα σχόλια (edit_4 κλπ) με τα στοιχεία σας. Καλό είναι να ξέρουμε ποιος κάνει τι...

     

    ακολουθεί ο κώδικας:

    ' EDIT_3 (Jun 2012): Few MAJOR changes.
    ' Added "Optional ArraySize As Long = 1"
    ' now: a = range to look into for match (could be range/ranges/array/name)
    '	  b = lime to look for OR lime with comparison elements (ex: >=2)
    '	  c Optional: If c exists then GetIf will return items from c (range/array...) where b matches a
    '				  if c is missing then GetIf returns the indexes of matches found
    '	  ArraySize Optional: Default =  1 : return 1 result
    '						  special = -1 : find quantity of matches through CountIF and return so many results
    '						  normal 1 to...: find as many as exist in an array as big as Asked!
    '							   When covering an array of N elements with GetIf it is especially useful to send an
    '							   Arraysize of N since it will return 0 elemements in empty slots while (-1) or a
    '							   smaller number will return #N/A in empty slots.
    ' GetIf will always return a Vertical Array of elements according to ArraSize {getif(N,1)}. Can be used normaly
    ' for one result (default) without Array experience. Use Traspose() of Excel to convert to Horizontal
    ' ex: transpose( GetIf(N,1) ) = GetIf(1,N)
    '
    ' TIPS: Use with excel formulas: Offset(),Index(),Smaller(),Larger(),Rows(1:N),Columns(1:N) for unlimited usage.
    ' See examples
    '
    ' Goylandris Apostolos
    '
    ' EDIT_2 (Jun 2012): c (range2) made Optional. If c is missing then return
    ' the Counter found so that range1(Counter)=b, then use Counter with Offset function!!!
    ' GoRandom has gone bye bye... complicated things
    '
    ' Goylandris Apostolos
    '
    ' EDIT_1
    ' H Optional-> GoRandom proste8hke gia tyxaio gemisma pinaka - mperdema, sto IKA
    ' to b egine b as string ka8ws se merikes periptwseis den edeine ta anamenomena. Pleon doyleyei kalytera
    '
    ' Goylandris Apostolos
    '
    ' Original (Apr 2008)
    ' Syntax exactly like SUMIF, that is "GetIf (Range1;Criteria;Range2)"
    ' and finds range2(i) so that range1(i)=criteria
    ' No controls/checks, no speed or other improvements made by function
    '
    ' Goylandris Apostolos
    '
    Public Function GetIf(a, b As String, Optional c, Optional ArraySize As Long = 1)
    Dim Counter As Long, Counter2 As Long, Counter3 As Long, dum1, EvalFL As Boolean, matchFL As Boolean
    Dim Counters() As Long, Holder()
    ' Fix ArraySize
    If ArraySize = 0 Then ArraySize = Evaluate(Application.WorksheetFunction.CountIf(a, )
    If ArraySize < 1 Then ArraySize = 1	 ' Restore to 1 even if evaluate finds 0 to avoid errors
    ' properly allocate arrays for VERTICAL results. Use TRANSPOSE() in excel fo HORIZONTAL
    ReDim Counters(1 To ArraySize, 1 To 1), Holder(1 To ArraySize, 1 To 1)
    ' Enable trapping for Greater than or Smaller than functions
    If InStr(b, ">") > 0 Then EvalFL = True
    If InStr(b, "<") > 0 Then EvalFL = True
    Counter = 0: Counter2 = 0: Counter3 = 0
    For Each dum1 In a				  ' Search for index
       Counter = Counter + 1: matchFL = False
       If EvalFL Then
        If Evaluate(Format(dum1, "#0") +  Then matchFL = True
       Else
        If b = Trim(dum1) Then matchFL = True
       End If
       If matchFL Then
        Counter3 = Counter3 + 1
        Counters(Counter3, 1) = Counter
        If Counter3 = ArraySize Then Exit For   'Search only as many as asked for
       End If
    Next
    If Counter3 > 0 Then					    ' if something was found
       If IsMissing(c) Then				    ' Edit:Jun2012 Ommitting range2 (c) returns Position within range
        GetIf = Counters
       Else
        Counter = 1
        For Each dum1 In c				  ' Use index to find equivalent
    	    Counter2 = Counter2 + 1
    	    If Counter2 = Counters(Counter, 1) Then
    		    Holder(Counter, 1) = dum1
    		    Counter = Counter + 1
    		    If Counter > Counter3 Then Exit For 'Search only as many as asked for
    	    End If
        Next
        GetIf = Holder
       End If
    Else
       GetIf = "-":
    End If
    End Function
    


  5. Επίσης το μείον της VBA είναι ότι αναγνωρίζει μόνο την τελεία ως δεκαδική υποδιαστολή

     

    προσθέτουμε μερικά IF και μερικά Replace() ακόμα, και για καλύτερη χρήση και ένα Optional στο κάλεσμα... και ιδού:

    Public Function EvalMath2(xc As String, Optional FixRegional As Boolean = False) As Double
    Dim n As Double, lt As Long, I As Long
    lt = Len(Trim(xc))
    If lt > 0 Then
    xc = LCase(xc)
    xc = Replace(xc, "χ", "*")
    xc = Replace(xc, "x", "*")
    xc = Replace(xc, "π", "pi()")
    xc = Replace(xc, "[", "(")
    xc = Replace(xc, "]", ")")
    xc = Replace(xc, "{", "(")
    xc = Replace(xc, "}", ")")
       If FixRegional Then
    	' remove Thousands separator
    	xc = Replace(xc, Application.International(xlThousandsSeparator), "")   ' xc = Replace(xc, ".", "")   ' or
    	' replace Decimal separator from WindowsDeafult to VBA Default "."
    	xc = Replace(xc, Application.International(xlDecimalSeparator), ".")	' xc = Replace(xc, ",", ".")  ' or
    End If
    
    n = Evaluate("=" + xc)
    Else
     n = 0
    End If
    EvalMath2 = n
    End Function
    

     

    (σημείωση: το "β) για όποιον έχει περιττά δεδομένα όπως μονάδες" δεν μπλέκει την κατάσταση χωρίς λόγο, οπότε το αφαίρεσα.)

    • Upvote 2

  6. Γιώργο καλημέρα

    "Math Evaluation" = a blast from the past!!! Ευχαριστούμε για την επαναφορά

     

    να σημειώσω ότι σε Excel 2010 χρειάστηκε αλλαγή σε public της function

    alt+f11 (για άνοιγμα VBA editor)

    Function EvalMath(xc As String) As Double --> Public Function EvalMath(xc As String) As Double

     

    προτείνω α)

    If xc <> "" Then --> If Trim(xc) <> "" Then

    έτσι προλαβαίνουμε την περίπτωση xc=" "

     

    β) για όποιον έχει περιττά δεδομένα όπως μονάδες

    προσθήκη της μπλε γραμμής:

    For I = 1 To lt

    If Mid$(xc, I, 1) = "×" Or Mid$(xc, I, 1) = "X" Or Mid$(xc, I, 1) = "x" Or Mid$(xc, I, 1) = "χ" Then

    Mid$(xc, I, 1) = "*"

    End If

    If Not InStr("0123456789+-*/.,()^", Mid$(xc, I, 1)) > 0 Then Mid$(xc, I, 1) = " "

    Next

     

    αν και εδώ θέλει προσοχή γιατί αν πχ έχετε "8+5 χιλιάδες" θα αλλάξει το "χ" με "*" και προκύπτει ΛΑΘΟΣ!!! οπότε πρέπει να διαλέξετε...

     

    γ) τολμώ να προτείνω μια παραλαγή της EvalMath, ας την πούμε EvalMath2. Την προτείνω αρχικά γιατί χρησιμοποιώντας συναρτήσεις της VBA είναι πολύ πιο απλή προγραμματιστικά, και πιο εύκολη για αλλαγές... κατά τα άλλα νομίζω ότι δουλεύουν το ίδιο. Με τη προσθήκη της επιλεκτίκής αφαίρεσης δεδομένων που δε συμμετέχουν σε πράξεις... ολοκληρωνόμαστε νομίζω.

     

    Public Function EvalMath2(xc As String, Optional RemoveStrings As Boolean = False) As Double

    Dim n As Double, lt As Long, I As Long

     

    lt = Len(Trim(xc))

    If lt > 0 Then

    If RemoveStrings = False Then

    xc = LCase(xc)

    xc = Replace(xc, "χ", "*")

    xc = Replace(xc, "x", "*")

    Else

    For I = 1 To lt

    If Not InStr("0123456789+-*/.,()^", Mid$(xc, I, 1)) > 0 Then Mid$(xc, I, 1) = " "

    Next

    End If

    n = Evaluate("=" & xc)

    Else

    n = 0

    End If

    EvalMath2 = n

     

    End Function

     

     

    αν / όταν κάνετε copy-paste στη VBA διορθώστε τα "χ" που ίσως περαστούν λάθος

    Προσέξτε καλά την replace, είναι φοβερή διευκόλυνση...


  7. Κάλυψη απαιτήσεων Solver για Office 2010 (ενεργοποίηση): FILE - Options - Add-Ιns - Manage (excel add-ins) ... GO - check Solver Add-in - OK

    (εφόσον έχει γίνει η αρχική εγκατάσταση)

     

    κάποτε (όταν ήμουν φοιτητής) είχα κάνει κάτι παρόμοιο με QB. Εννοείται χωρίς solver κλπ. Μόλις ευκαιρήσω να το μετατρέψω για Excel θα το ανεβάσω.

    Ευχαριστούμε


  8. Φίλε μου,δεν ξέρω με ποιό πρόγραμμα έχεις συμπιέσει το αρχείο,αλλά δεν μπορώ να το αποσυμπιέσω ούτε με Winzip ούτε με Winrar μετά το download.Καμιά ιδέα;;;

     

    Και εγώ το ίδιο πρόβλημα έχω. Δεν κάνει αποσυμπίεση.

     

    Το έχω κάνει με το 7-zip που υπάρχει εδώ http://www.7-zip.org/download.html (open source) και υπάρχει και portable (δεν χρειάζεται εγκατάσταση) εδώ http://portableapps.com/apps/utilities/7-zip_portable . Όμως το αρχείο είναι κανονικό zip-ακι και σε εμένα πάλι το βλέπουν και το ανοίγουν και τα windows κανονικά (win7).

×
×
  • 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.