Funkcja EVAL.   strona główna:
A po co ten Excel ;-)
 
Nie brakowało Wam kiedyś funkcji w Excelu? Np.: InStrRev, MonthName, czy choćby IsDate ?  
Jest na to rada :-) Właśnie EVAL  
 
Dostępna jest w M$ ACCESS jako Application.Eval i tam również pierwszy raz się z nią zetknąłem. Funkcja ta przyjmuje jako argument  
ciąg tekstowy i zwraca wynik działań w nim zdefiniowany. Prostym przykładem byłyby:  
 
    ? Application.Eval("1 + 2")  
    ? Application.Eval("(1 > 2) EQV ( 2 = 3 )") = True  
    ? Application.Eval("InStr(""tkuchta1"",""a1"")")  
    ? Application.Eval("Mid(""wsxert"", 3, 1)")  
    ? Application.Eval("MsgBox(""Tekst"",1, ""błąd"")")  
 
Wpisane o okno Imediate Edytowa VB Accessa zwracają odpowiednio wyniki: 3; True; 7; x; (po kliknięciu na OK. - 1)  
 
    Jak widać funkcyjka zwraca wyniki nie tylko dla banalnych zadań ale również dla operatorów logicznych, ale i innych funkcji i to jest  
coś na czym warto zawiesić na chwilę oko.  
 
    Odpowiednikiem tej funkcji Accessa w Exceu jest Metoda Application.Evaluate jednak przeważnie używa się jej do innych celów jak   
odwołania do zakresów. Czy można używać tej metody tak jak funkcji Eval Accessa? Sprawdźmy :-)  
 
    ? Application.Evaluate("1+2")  
    ? Application.Evaluate("(1 > 2) EQV ( 2 = 3 )")  
    ? Application.Evaluate("InStr(""tkuchta1"",""a1"")")  
    ? Application.Evaluate("Mid(""wsxert"", 3, 1)")  
    ? Application.Evaluate("MsgBox(""Tekst"",1, ""błąd"")")  
 
Próby zwracają następujące wyniki: 3; Error 2015; Error 2029; 7; Error 2029  
A więc metoda nie zwraca wyników gdy w treści pojawią się operatory (jakiekolwiek: AND, OR ...) lub niektóre funkcje. Szkoda :-(   
 
Czy więc kiedy przyjdzie nam sprawdzić wynik dla warunków zapisanych w ciągu tekstowym trzeba będzie tworzyć referencję do obiektu  
Accessa? To byłoby jeż małą przesadą. Nie na każdym kompie, na którym jest Excel, jest również Access. Jest to jednak trochu droższa  
zabawka ;-).  
    Istnieje inny sposób :-). Swoją funkcję Eval oferuje nam biblioteka  
Microsoft Script Control ( u mnie w wersji 1.0 )  
Dodajmy (tymczasowo) referencję do tej biblioteki i napiszmy test  
 
Sub test()  
    Dim objScriptControl As MSScriptControl.ScriptControl  
      
    Set objScriptControl = New MSScriptControl.ScriptControl  
    With objScriptControl  
        .Language = "VBScript"  
          
        Debug.Print .Eval("1+2")  
          
    End With  
    Set objScriptControl = Nothing  
End Sub  
 
Ha.. :-) Gro i Bucy (z góralskiego)  
 
Napiszmy więc funkcję, która stworzy poprzez funkcje VBA.CreateObject (późne wiązanie - referencja do biblioteki staje się niepotrzebna)  
obiekt tej bibioteki i wykona określone polecenie przez jej funkcję Eval.   
 
Function Eval(strPolecenie As String, _  
              Optional strLanguage As String = "VBScript")  
    Dim objScrContr As Object  
      
    Set objScrContr = VBA.CreateObject("MSScriptControl.ScriptControl")  
    With objScrContr  
        .Language = strLanguage  
        Eval = .Eval(strPolecenie)  
    End With  
    Set objScrContr = Nothing  
End Function  
 
I co maleństwo potrafi :-)  
 
Daje nam dostęp do wszystkich funkcji VBScript   Słownik funkcji VBScript
 
Przykłady Wykorzystania  
Jako funkcj arkuszowa:  
          Dla wprawy parę prostych przykładów :-)  
 
      Przykład.1 Czy dany ciąg jest datą?  
 
               =Eval("IsDate(""2009-05-26"")")  
               =Eval("IsDate(""" & A1 & """)")  
 
      Przykład.2 Nazwa 8'mego miesiąca?  
 
               =Eval("MonthName(""8"")")  
 
           Alternatywa wbudowanymi funkcjami  
               =TEKST(DATA(1;8;1);"mmmm")  
 
      Przykład.3 Jak odwrócić kolejność znaków w ciągu tekstowym?  
 
               =Eval("StrReverse(""123456789"")")   EXCELBLOG
  Odwracanie kolejności liter w wyrazach oraz wyrazów w zdaniach
          No i ciekawe zastosowania :-D  
 
      Przykład.4 Jak z pełnej ścieżki wyciągnąć nazwę pliku .Jak okreslić pozycję ostatniego "\" w ciągu ?  
W kom.A1 znajduje się ciąg: C:\Documents and Settings\tkuchta1\Pulpit\Warsztat\stronka\Eval.xls  
 
               =PRAWY(A1;DŁ(A1)-Eval("InStrRev(""" & A1 & """,""\"",Len(""" & A1 & """))"))  
 
           Alternatywa wbudowanymi funkcjami (formuła tablicowa - zatwierdzana Ctrl+Shift+Enter)  
=PRAWY(A1;DŁ(A1)-MAX(JEŻELI(FRAGMENT.TEKSTU(A1;WIERSZ(ADR.POŚR("1:" & DŁ(A1)));1)="\";WIERSZ(ADR.POŚR("1:" &DŁ(A1)));0)))  
 
      Przykład.5 Jak z pełnej ścieżki wyciągnąć nazwy kolejnych katalogów od C: do nazwy pliku?  
W kom.A1 znajduje się ciąg: C:\Documents and Settings\tkuchta1\Pulpit\Warsztat\stronka\Eval.xls   VBScript Split Function
 
              =Eval("Split(""" & $A$1 & """,""\"") (" & WIERSZ(1:1)-1 & ")")  
                                 (formułę przeciągnąć w dół)  
  VBScript MsgBox Function
      Przykład.6 Zawartość kom.A1 jest ustalana formułą! Jeżeli wartość tej komórki będzie < 2 niech zostanie wyświetlone okno dialogowe z   informacje nt. stałych stosowanych
informacją, której zawartość to komunikat z kom.B1 oraz tytułem że to niewielki błąd. Gdy wartość będzie > 2 błąd jest duży, a komunikat niech   w f. Msgbox
zostanie pobrany z kom.B2. Jeżli = 2 brak komunikatu.   oraz stałe, które zwraca
         To takie rzeczy można robić formułą? TAK!! :-)  
 
=JEŻELI(A1<>2;Eval("MsgBox(""" & JEŻELI(A1<2;B1;B2) & """,vbOkOnly + " & JEŻELI(A1<2;"vbExclamation";"vbCritical") & ",""" & JEŻELI(A1<2;"Mały błąd";"DUŻY Błąd") & """)");"")  
 
         Nie proste? :-D Alternatywą byłoby wykorzystanie zdarzeń Worksheet_Calculate lub Workbook_SheetCalculate z zapamiętywaniem w  
publicznej zmiennej zdefiniowanej w module standardowym wartości kom.A1 i uzależnienie wywołania odpowiednio zdefiniowanego okna od zmiany  
w tej komórce.  
         To samo można dla f. InputBox w której w formule można określić nawet pozycję okna, na której ma pokazać się okno dialogowe :-)  
Dla przykładu  
 
              =Eval("InputBox(""Wiadomość"",""Tytuł"",""domyślny"",""5500"",""300"")")   VBScript InputBox Function
 
Funkcje te zwracają wartości.  
    Funicka MsgBox zgodne z klikniętym przyciskiem - wartość stałej zdefiniowanej w bibliotece z której pochodzi funkcjia  
    Funkcjia InputBox zgodnie z ciągniem wpisanym (lub nie) do okna dialogowego  
Wartości te są zwracane do komórki w której wpisano formułę. Jeżeli nie chcemy żeby ten wynik był widoczny dla użytkownika proponuję nadać  
tej komórce formatowanie niestandardowe typ: ;;; co i tak nie przeszkodzi nam wykorzystać te wyniki do dalszych obliczeń formułami, które  
będą warunkowo odwoływać się do tego wyniku.  
 
    To wydaje Wam się niesamowite - przeczytajcie następny przykład :-)  
 
      Przykład.7 w kom.A1 mamy ciąg: dane test 152.2 info 2 próba15 1 15aa, 25.9   mój artykuł
Jak wyciągnąć wartości liczbowe (separator dziesiętny to ".") z tego ciągu do kolejnych kolumn?   VBScript.RegExp w VBA
  dot. Zastosowania
Jedną formułą :-? Zadanie nie proste. :-| W VBA najlepiej byłoby załatwić sprawę Wyrażeniami Regularnymi. A formułami ??    Wyrażeń Regularnych w VBA
A co powiecie żeby tutaj również poradzić sobie Wyrażeniami Regularnymi :-) Nie żartuję! Eval i to potrafi :-)  
Jednak do obsługi Wyrażeń Regularnych trzeba będzie korzystać z JavaScript. Do określenia, że to właśnie z tego języka chcemy korzystać  
w drugim (opcjonalnym) parametrze naszej funkcji Eval wpiszemy ciąg "JavaScript"   RegExp w JavaScript
O wyrażeniach regularnych w JavaScript można by śmiało napisać oddzielny artykuł ale wszystko co natenczas byłoby nam potrzebne to wiedza,   info nt. Pattern, Flag, Metod
że: Pattern określany jest tak samo jak w VBScript.RegExp tyle, że całość ciągu zapisujemy pomiędzy backslash' e /.../ , a po tym ciągu można   z Przykładami :-)
nadawać flagi dot. sposobu wyszukiwania ciągów. Np.: i  to IgnoreCase = True z VBScript.RegExp, g to Global = True ...  
 
    Wróćmy do naszego zadania :-) Funkcja wyciągająca liczby z ciągu, zwracająca wszystkie dopasowania rozdzielone przecinkami to:  
              =Eval("""" & $A$1 & """.match(/\d+(\.\d+)?/g)";"JavaScript")  
do wyciągnięcia elementów tego dopasowania posłużymy się inną metodą RegExp tj. Split, podając separator tj "," oraz nr. elementu utworzonej  
przez funkcję tablicy.  
              =Eval("""" & wynik_ww_dopasowania & """.split(/,/) [" & NR.KOLUMNY(A1)-1 & "]";"JavaScript")  
formułę przeciągnąć w prawo. I po zadaniu.  
 
Jeżeli kogoś to nie zachwyciło nierozumie mocy drzemiących w wyrażeniach regularnych.   
Czytać i próbować!  
Warto mieć tą wiedzę w arsenale znanych narzędzi - naprawdę warto!!  
 
Oczywiście można używać innych metod RegExp :-)  
     Czy w ciągu znajduje się kod pocztowy?  
              =Eval("""" & $A$1 & """.search(/\d{2}-\d{3}/)";"JavaScript")>0  
     Jak w miejsce kodów pocztowych wstawić własny ciąg?  
              =Eval("""" & $A$1 & """.replace(/\d{2}-\d{3}/g,"" kod "")";"JavaScript")  
     Jak podzielić ten ciąg na wyrazy zwracane w kolejnych komórkach?  
              =Eval("""" & $A$1 & """.split(/\s/) [" & WIERSZ(1:1)-1 & "]";"JavaScript")  
     Każdy znak ciągu w następnej komórce?  
              =Eval("""" & $A$1 & """.split(/\.*/) [" & WIERSZ(1:1)-1 & "]";"JavaScript")  
     Każda liczba z ciągu w naspęnych komórach (nie tworząć kolekcji match) ?  
              =Eval("""" & $A$1 & """.split(/\D+/) [" & WIERSZ(1:1)-1 & "]";"JavaScript")  
 
 
Przykłady Wykorzystania  
w VBA  
  Przykład wraz z
      Przykład.1 Jak uzależnić zawartość ListBox'a od wyników filtrowania danych Autofiltrem.   plikami do ściągnięcia
 
    Gdyby po prostu chodzilo o przeniesienie zakresu do ListBox'a wystarczyło by zadeklarować tablicę, zapisać do niej zakres i wskazać tę tablicę  
we właściwości List ListBox'a. Jeżeli jednak nie cały zakres nas interesuje tablica musi być dynamiczna, a o przeniesieniu części zakresu (wiersza)  
do zakresu będzie decydował warunek. A jeżeli warunek nie jest z góry znany a definiuje go założony na zakres Autofiltr?.. :-)  
 
Pomysł rozwiązania jest oparty o przechwytywanie kryteriów ustalonych w Autofiltrze. Realizować to będzie funkcja:  
 
Function AutoFilter_Criteria(Header As Range, doPorow As Variant) As String  
    '--------------------na podstawie---------------------  
    '--http://www.ozgrid.com/VBA/autofilter-criteria.htm--  
    Dim strCri1 As String, strCri2 As String  
    Application.Volatile  
      
    With Header.Parent.AutoFilter  
        With .Filters(Header.Column - .Range.Column + 1)  
            If Not .On Then Exit Function  
            strCri1 = .Criteria1  
            If .Operator = xlAnd Then  
                strCri2 = " AND " & doPorow & " " & .Criteria2  
            ElseIf .Operator = xlOr Then  
                strCri2 = " OR " & doPorow & " " & .Criteria2  
            End If  
        End With  
    End With  
    AutoFilter_Criteria = strCri1 & strCri2  
End Function  
 
Funkcja podaje zestaw kryteriów wskazanych do wyfiltrowania zakresu przez użytkownika.   
     Kiedy wywołany jest UserForm (oczywiście vbModeless) zmiana kryteriów ma zmieniać zawartość ListBox'a. Jednak sama zmiana kryteriów i   
reakcja filtra ukrywającego pewien zakres danych nie powodują zdarzenia Worksheet_Calculate, w którym zdefiniowalibyśmy procedurę aktualizu-  
jącą ListBox. Wystarczy jednak dodać do Arkusza jedną z funkcji Nietrwałych: =LOS(); =TERAZ(); ... A zmiana kryteriów filtrowania spowoduje   
calculate Arkusza :-)  
     No dobra mamy kryteria, ale trzeba nam True albo False. Ten co myśli że Application.Evaluate nam nie pomoże. Ma rację! Trzeba Eval! :-)  
a wtedy wystarczy tylko w kodzie Arkusza  
 
Private Sub Worksheet_Calculate()  
    Dim ctrListBox As MsForms.ListBox  
    Dim tblZakres As Variant, iZak As Long  
    Dim tblDane() As Variant, iTbl As Long, jTbl As Integer  
    Dim rngKol1 As Excel.Range, rngHeader As Excel.Range  
 
    tblZakres = Range("Tabela1")  
    Set rngKol1 = Range("Tabela1").Columns(1)  
    Set rngHeader = rngKol1.Cells(1)  
      
    ReDim tblDane(1 To Application.Subtotal(103, rngKol1) - 1, 1 To 5)  
    On Error Resume Next  
    For iZak = LBound(tblZakres) + 1 To UBound(tblZakres)  
        If Eval(tblZakres(iZak, 1) & " " & AutoFilter_Criteria(rngHeader, tblZakres(iZak, 1))) Then  
            iTbl = iTbl + 1  
            For jTbl = 1 To 5  
                tblDane(iTbl, jTbl) = tblZakres(iZak, jTbl)  
            Next  
        End If  
    Next  
          
    Set ctrListBox = UserForm1.ListBox1  
    With ctrListBox  
        .Clear  
        .List = tblDane  
    End With  
    Set ctrListBox = Nothing  
End Sub  
 
i gotowe :-)  
   Jednak działa dobrze tylko w Excelu <=2003 :-| W Excelu 2007 dodano nowe operatory jakie można wykorzystać do filtrowania dat, oraz wskazy-   Próby dostosowania
wania jako kryteriów filtrowania więcej niż 2 elementów filtrowanego zakresu: xlFilterValues i xlFilterDynamic oraz masę stałych przez nie wykorzy-   f. AutoFilter_Criteria
stywanych. Funkcja AutoFilter_Criteria mysiałaby być znacznie bardziej rozbudowana, a niektóre jej mechanizmy: dot. stałych definiujących specy-   do E2007
ficzne zakresy danych - napisane dla niej od nowa. Zabawa traci wtedy sens. Trzeba by szukać innych rozwiązań.   
Kierunek SpecialCells(xlCellTypeVisible)