Tylko cyfry


Funkcja tylkoCyfry korzysta podczas działania z innych nie-wbudowanych funkcji prezentowanych na tej stronie, które w związku z tym również muszą być umieszczone w kodzie projektu dla prawidłowego działania tej funkcji.

Nie uwzględnienie ich w kodzie spowoduje wygenerowanie błędu: Compile error: Sub or Function not defined.

Dodatkowe funkcje wykorzystywane w funkcji tylkoCyfry zostały wymienione poniżej. Klikając w nazwę każdej z nich przeniesiesz się do podstrony zawierającej jej kod:

Dodając powyższe funkcje, zwróć uwagę czy nie były one już wcześniej wykorzystywane w Twoim kodzie. Obecność w jednym projekcie VBA dwóch funkcji publicznych o identycznych nazwach spowoduje wygenerowanie błędu kompilacji o treści: Compile error: Ambiguous name detected: nazwa_funkcji.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
'**********************************************************************************************************
' Nazwa:                tylkoCyfry
' Autor:                mielk | 2011-07-15
'
' Opis:                 Funkcja usuwająca z podanego tekst bazowego wszystkie znaki niebędące cyframi lub
'                       znakami typowymi dla opisu liczb (minus, kropka i przecinek).'
' Argumenty:
'   tekst               Tekst bazowy, który ma zostać przerobiony przez tę funkcję.
'                       W rzeczywistości funkcja może też przyjmować argumenty o innych typach danych niż
'                       String - jeżeli jest to możliwe argument zostaje przekonwertowany do typu String,
'                       w przeciwnym razie zwracany jest wyjątek NiedozwolonyTypZmiennej.
'   pozostawZnakiSpecjalne
'                       Opcjonalny argument typu Boolean, określający czy znaki specjalne powszechnie
'                       stosowane do opisywania liczb (np. minus, kropka czy przecinek) mają być traktowane
'                       jak cyfry i zwrócone w wyniku funkcji.
'                       * Jeżeli wartość tego argumentu ustawiona jest na True - zwracany ciąg znaków
'                         zawiera znaki specjalne.
'                       * Jeżeli argument ustawiony jest na False, funkcja zwróci tylko cyfry usuwając bez
'                         wyjątku wszystkie inne znaki.
'                       * Domyślnie parametr ten ustawiony jest jako True.
'
' Zwraca:
'   String              Tekst bazowy przetworzony tak, że usunięto z niego wszystkie znaki oprócz cyfr
'                       (oraz ewentualnie znaków specjalnych - w zależności od podanej wartości argumentu
'                       pozostawZnakiSpecjalne).
'
'
'
' Wyjątki:
'   NiedozwolonyTypZmiennej         Zwracany, kiedy parametr podany do tej funkcji nie może zostać
'                                   przekonwertowany do typu String.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2011-07-15        mielk           Utworzenie funkcji.
' 2013-05-17        mielk           Funkcja akceptuje teraz tylko jeden minus oraz jeden separator
'                                   dziesiętny oraz sprawdza czy są one położone w odpowiednich  miejscach
'                                   (np. minus na początku liczby).
' 2013-06-04        mielk           Separator dziesiętny nie jest już więcej pobierany z ustawień
'                                   systemowych, ponieważ różnią się one od wewnętrznych ustawień MS Office
'                                   i nie można na nich w tej sytuacji polegać.
'**********************************************************************************************************
Public Function tylkoCyfry(ByVal text As Variant, _
                                         Optional ByVal pozostawZnakiSpecjalne As Boolean = True) As String
    Const NAZWA_METODY As String = "tylkoCyfry"
    '------------------------------------------------------------------------------------------------------
    Const MINUS As String = "-"
    Const PRZECINEK As String = ","
    Const KROPKA As String = "."
    '------------------------------------------------------------------------------------------------------
    Dim sTekst As String
    Dim iZnak As Integer
    Dim sZnak As String
    Dim iAscii As Integer
    Dim bPrzecinek As Boolean
    '------------------------------------------------------------------------------------------------------


    'Funkcja próbuje przekonwertować podany argument do typu String. Jeżeli nie jest to możliwe ---------|
    '(np. podany argument jest tablicą lub obiektem), wykonywanie kodu przenoszone jest do              '|
    'wyjątku NiedozwolonyTypZmiennej.                                                                   '|
    On Error GoTo NiedozwolonyTypZmiennej                                                               '|
    sTekst = VBA.CStr(text)                                                                             '|
    '----------------------------------------------------------------------------------------------------|



    'Analizuje kolejno każdy pojedynczy znak tekstu bazowego.
    For iZnak = 1 To VBA.Len(sTekst)

        'Przypisuje do zmiennej [sZnak] pojedynczy znak z tekstu bazowego.
        sZnak = VBA.Mid$(sTekst, iZnak, 1)

        'Sprawdź czy znak analizowany w tym momencie przez pętlę jest cyfrą. ----------------------------|
        If czyCyfra(sZnak) Then                                                                         '|
                                                                                                        '|
            tylkoCyfry = tylkoCyfry & sZnak                                                             '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Jeżeli parametr [pozostawZnakiSpecjalne] jest ustawiony na, funkcja mus sprawdzić ------|  '|
            'czy analizowany znak jest minusem, kropką lub przecinkiem.                             '|  '|
            If pozostawZnakiSpecjalne Then                                                          '|  '|
                                                                                                    '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                If sZnak = MINUS Then                                                           '|  '|  '|
                                                                                                '|  '|  '|
                    'Minus może zostać dodany tylko na początku liczby. Dlatego -------------|  '|  '|  '|
                    'przed jego dodaniem trzeba sprawdzić czy wynik funkcji nadal jest      '|  '|  '|  '|
                    'pusty.                                                                 '|  '|  '|  '|
                    If VBA.Len(tylkoCyfry) = 0 Then                                         '|  '|  '|  '|
                                                                                            '|  '|  '|  '|
                        'Co więcej, interesuje nas tylko taki minus, które w tekście ----|  '|  '|  '|  '|
                        'źródłowym poprzedzał bezpośrednio cyfrę (a więc jest pewność,  '|  '|  '|  '|  '|
                        'że odnosił się do tej cyfry).                                  '|  '|  '|  '|  '|
                        If iZnak < VBA.Len(sTekst) Then                                 '|  '|  '|  '|  '|
                            If czyCyfra(VBA.Mid$(sTekst, iZnak + 1, 1)) Then            '|  '|  '|  '|  '|
                                tylkoCyfry = MINUS                                      '|  '|  '|  '|  '|
                            End If                                                      '|  '|  '|  '|  '|
                        End If                                                          '|  '|  '|  '|  '|
                        '----------------------------------------------------------------|  '|  '|  '|  '|
                                                                                            '|  '|  '|  '|
                    End If                                                                  '|  '|  '|  '|
                    '------------------------------------------------------------------------|  '|  '|  '|
                                                                                                '|  '|  '|
                'Liczba może zawierać tylko jeden separator dziesiętny, więc przed dodaniem     '|  '|  '|
                'separatora trzeba sprawdzić czy nie został on już dodany wcześniej.            '|  '|  '|
                ElseIf Not bPrzecinek And (sZnak = PRZECINEK Or sZnak = KROPKA) Then            '|  '|  '|
                                                                                                '|  '|  '|
                    'Separator dziesiętny nie może znajdować się na początku liczby, musi ---|  '|  '|  '|
                    'być poprzedziony przynajmniej jedną cyfrą. Dlatego przed dodaniem      '|  '|  '|  '|
                    'separatora trzeba jeszcze sprawdzić czy wynik funkcji posiada już      '|  '|  '|  '|
                    'jakąś cyfrę.                                                           '|  '|  '|  '|
                    If VBA.Len(tylkoCyfry) Then                                             '|  '|  '|  '|
                        If VBA.right$(tylkoCyfry, 1) <> MINUS Then                          '|  '|  '|  '|
                                                                                            '|  '|  '|  '|
                            tylkoCyfry = tylkoCyfry & Application.decimalSeparator          '|  '|  '|  '|
                            bPrzecinek = True                                               '|  '|  '|  '|
                                                                                            '|  '|  '|  '|
                        End If                                                              '|  '|  '|  '|
                    End If                                                                  '|  '|  '|  '|
                    '------------------------------------------------------------------------|  '|  '|  '|
                                                                                                '|  '|  '|
                                                                                                '|  '|  '|
                End If                                                                          '|  '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
            End If                                                                                  '|  '|
            '-------- [If pozostawZnakiSpecjalne Then] ----------------------------------------------|  '|
                                                                                                        '|
        End If                                                                                          '|
        '------------ [If isDigit(sZnak) Then] ----------------------------------------------------------|

    Next iZnak



'==========================================================================================================
PunktWyjscia:
    Exit Function


'----------------------------------------------------------------------------------------------------------
NiedozwolonyTypZmiennej:
    '(...)
    'Obsługa błędów dla sytuacji, kiedy parametr podany do funkcji nie może zostać przekonwertowany do typu
    'Strign

    GoTo PunktWyjscia

End Function