'********************************************************************************************************** ' Nazwa: rozpocznijZWielkiej ' Autor: mielk | 2013-06-05 ' ' Opis: Funkcja modyfikująca podany tekst w ten sposób, że zamienia jego pierwszy znak na ' wielką literę. Pozostałe znaki tekstu bazowego pozostaną niezmienione. ' ' Argumenty: ' tekst Tekst do zamiany. ' ' Zwraca: ' String Bazowy tekst z pierwszym znakiem zamienionym na wielką literę. ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2013-06-05 mielk Utworzenie funkcji. '********************************************************************************************************** Public Function rozpocznijZWielkiej(ByVal tekst As String) As String Const NAZWA_METODY As String = "rozpocznijZWielkiej" '------------------------------------------------------------------------------------------------------ rozpocznijZWielkiej = VBA.UCase$(VBA.Left$(tekst, 1)) & VBA.Mid$(tekst, 2) End Function ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: removeEndingCarriage '' Autor: mielk | 2013-06-05 '' '' Opis: Function to remove the symbol of new lines (carriage '' returns) at the end of the given string. '' '' Argumenty: '' tekst String to be cleared from ending carriage return. '' '' Zwraca: '' String The original string without the ending carriage return. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-06-05 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function removeEndingCarriage(ByVal tekst As String) As String ' Const NAZWA_METODY As String = "removeEndingCarriage" ' '------------------------------------------------------------------------------------------------------------------- ' Const CARRIAGE_RETURN_ASC As Integer = 10 ' Const ENTER_ASC As Integer = 13 ' '------------------------------------------------------------------------------------------------------------------- ' Dim intLastChar As Integer ' Dim lngChar As Long ' '------------------------------------------------------------------------------------------------------------------- ' ' For lngChar = VBA.Len(tekst) To 1 Step -1 ' intLastChar = VBA.Asc(VBA.Mid$(tekst, lngChar, 1)) ' If intLastChar <> CARRIAGE_RETURN_ASC And intLastChar <> ENTER_ASC Then Exit For ' Next lngChar ' ' ' If lngChar Then ' removeEndingCarriage = VBA.left$(tekst, lngChar) ' End If ' 'End Function ' ' ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: toReversedCase '' Autor: mielk | 2013-05-16 '' '' Opis: Reverse the specified string. '' '' Argumenty: '' tekst String to be reverted. '' ignoreNumbers '' Determines if the numbers should be ignored and returned '' without being reverted. '' ignoreDates '' Determines if the dates should be ignored and returned '' without being reverted. '' '' Zwraca: '' String The original string after reversion. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function toReversedCase(tekst As Variant, ignoreNumbers As Boolean, _ ' ignoreDates As Boolean) As Variant ' Const NAZWA_METODY As String = "toReversedCase" ' '------------------------------------------------------------------------------------------------------------------- ' ' If VBA.IsDate(tekst) Then ' Dim sDate As String: sDate = VBA.Format(tekst, DATE_FORMAT) ' If ignoreDates Then toReversedCase = sDate Else toReversedCase = VBA.StrReverse(sDate) ' ElseIf VBA.IsNumeric(tekst) And ignoreNumbers Then ' toReversedCase = tekst ' Else ' toReversedCase = VBA.StrReverse(tekst) ' End If ' 'End Function ' ' ' ''********************************************************************************************************** '' Nazwa: toTextCase '' Autor: mielk | 2013-05-16 '' '' Opis: Convert the given value to its String representation. '' '' Argumenty: '' value Value to be converted. '' '' Zwraca: '' String The String representation of the original value. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function toTextCase(tekst As Variant) As String ' Const NAZWA_METODY As String = "toTextCase" ' '------------------------------------------------------------------------------------------------------------------- ' ' On Error GoTo InconvertibleException ' ' If VBA.IsNumeric(tekst) Then ' toTextCase = "'" & tekst ' ElseIf VBA.IsDate(tekst) Then ' toTextCase = "'" & VBA.Format(tekst, DATE_FORMAT) ' Else ' toTextCase = tekst ' End If ' ' ''--------------------------------- 'PunktWyjscia: ' Exit Function ' ''--------------------------------- 'InconvertibleException: ' toTextCase = VBA.TypeName(tekst) ' GoTo PunktWyjscia ' 'End Function ' ' ' ''********************************************************************************************************** '' Nazwa: toNumericCase '' Autor: mielk | 2013-05-16 '' '' Opis: Converts the given string to a number if it is the tekst '' represenation of number or remain it without any changes '' otherwise. '' '' Argumenty: '' tekst String to be converted. '' '' Zwraca: '' Variant The original string converted to the proper format (numeric '' for numbers, DateTime format for dates, String for tekst). '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function toNumericCase(tekst As String) As Variant ' Const NAZWA_METODY As String = "toNumericCase" ' '------------------------------------------------------------------------------------------------------------------- ' ' If VBA.IsNumeric(tekst) Then ' toNumericCase = tekst * 1 ' ElseIf VBA.IsDate(tekst) Then ' toNumericCase = VBA.CDate(tekst) ' Else ' toNumericCase = tekst ' End If ' 'End Function ' ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: removeNumbers '' Autor: mielk | 2013-05-16 '' '' Opis: Removes all numbers from the given tekst. '' '' Argumenty: '' tekst String to be converted. '' '' Zwraca: '' String The original string after removing all the numbers. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function removeNumbers(tekst As String) As String ' Const NAZWA_METODY As String = "removeNumbers" ' '------------------------------------------------------------------------------------------------------------------- ' Const ASC_0 As Integer = 48 ' Const ASC_9 As Integer = 57 ' '------------------------------------------------------------------------------------------------------------------- ' Dim intChar As Integer ' Dim strChar As String ' Dim intAsc As Integer ' '------------------------------------------------------------------------------------------------------------------- ' ' For intChar = 1 To VBA.Len(tekst) ' strChar = VBA.Mid$(tekst, intChar, 1) ' intAsc = VBA.Asc(strChar) ' If intAsc < ASC_0 Or intAsc > ASC_9 Then ' removeNumbers = removeNumbers & strChar ' End If ' Next intChar ' 'End Function ' ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: removeSpecialChars '' Autor: mielk | 2013-05-16 '' '' Opis: Removes all special characters from the given tekst. '' Every non-digit and non-letter character, except for white '' characters (like space, tab or new line carriage) are '' considered as special character. '' '' Argumenty: '' tekst String to be converted. '' '' Zwraca: '' String The original string after removing all the special '' characters. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function removeSpecialChars(tekst As String) As String ' Const NAZWA_METODY As String = "removeSpecialChars" ' '------------------------------------------------------------------------------------------------------------------- ' Const ASC_0 As Integer = 48 ' Const ASC_9 As Integer = 57 ' Const ASC_A_LOW As Integer = 97 ' Const ASC_Z_LOW As Integer = 122 ' Const ASC_A_UPPER As Integer = 65 ' Const ASC_Z_UPPER As Integer = 90 ' Const ASC_SPACE As Integer = 32 ' Const LOCAL_CHARS As String = "|138|140|141|142|143|" & _ ' "154|156|157|158|159|163|165|170|175|179|181|" & _ ' "185|186|188|190|191|192|193|194|195|196|197|" & _ ' "198|199|200|201|202|203|204|205|206|207|208|" & _ ' "209|210|211|212|213|214|216|217|218|219|220|" & _ ' "221|222|223|224|225|226|227|228|229|230|231|" & _ ' "232|233|234|235|236|237|238|239|240|241|242|" & _ ' "243|244|245|246|248|249|250|251|252|253|254|" ' '------------------------------------------------------------------------------------------------------------------- ' Dim intChar As Integer ' Dim strChar As String ' Dim intAsc As Integer ' '------------------------------------------------------------------------------------------------------------------- ' ' For intChar = 1 To VBA.Len(tekst) ' strChar = VBA.Mid$(tekst, intChar, 1) ' intAsc = VBA.Asc(strChar) ' ' If intAsc >= ASC_A_LOW And intAsc <= ASC_Z_LOW Then ' removeSpecialChars = removeSpecialChars & strChar ' ElseIf intAsc >= ASC_A_UPPER And intAsc <= ASC_Z_UPPER Then ' removeSpecialChars = removeSpecialChars & strChar ' ElseIf intAsc >= ASC_0 And intAsc <= ASC_9 Then ' removeSpecialChars = removeSpecialChars & strChar ' ElseIf intAsc <= ASC_SPACE Then ' removeSpecialChars = removeSpecialChars & strChar ' ElseIf VBA.InStr(1, LOCAL_CHARS, "|" & intAsc & "|", vbBinaryCompare) Then ' removeSpecialChars = removeSpecialChars & strChar ' End If ' ' Next intChar ' 'End Function ' ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: removeLetters '' Autor: mielk | 2013-05-16 '' '' Opis: Removes all letters from the given tekst. '' '' Argumenty: '' tekst String to be converted. '' '' Zwraca: '' String The original string after removing all the letters. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function removeLetters(tekst As String) As String ' Const NAZWA_METODY As String = "removeLetters" ' '------------------------------------------------------------------------------------------------------------------- ' Const ASC_A_LOW As Integer = 97 ' Const ASC_Z_LOW As Integer = 122 ' Const ASC_A_UPPER As Integer = 65 ' Const ASC_Z_UPPER As Integer = 90 ' Const LOCAL_CHARS As String = "|138|140|141|142|143|" & _ ' "154|156|157|158|159|163|165|170|175|179|181|" & _ ' "185|186|188|190|191|192|193|194|195|196|197|" & _ ' "198|199|200|201|202|203|204|205|206|207|208|" & _ ' "209|210|211|212|213|214|216|217|218|219|220|" & _ ' "221|222|223|224|225|226|227|228|229|230|231|" & _ ' "232|233|234|235|236|237|238|239|240|241|242|" & _ ' "243|244|245|246|248|249|250|251|252|253|254|" ' '------------------------------------------------------------------------------------------------------------------- ' Dim intChar As Integer ' Dim strChar As String ' Dim intAsc As Integer ' '------------------------------------------------------------------------------------------------------------------- ' ' ' For intChar = 1 To VBA.Len(tekst) ' strChar = VBA.Mid$(tekst, intChar, 1) ' intAsc = VBA.Asc(strChar) ' ' If intAsc >= ASC_A_LOW And intAsc <= ASC_Z_LOW Then ' 'Lower case letters ' ElseIf intAsc >= ASC_A_UPPER And intAsc <= ASC_Z_UPPER Then ' 'Upper case letters ' ElseIf VBA.InStr(1, LOCAL_CHARS, "|" & intAsc & "|", vbBinaryCompare) Then ' 'Local characters ' Else ' removeLetters = removeLetters & strChar ' End If ' ' Next intChar ' 'End Function ' ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: only Letters '' Autor: mielk | 2013-05-17 '' '' Opis: Function to remove all but letters (and white spaces) from '' the specified tekst. '' '' Argumenty: '' tekst String to be converted. '' leaveSpaces Optional parameter of Boolean type. It determines if white '' spaces should be also included in the result string. '' Default value of this parameter is True. '' '' Zwraca: '' String The original string after removing all the letters. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-17 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function onlyLetters(tekst As String, _ ' Optional leaveSpaces As Boolean = True) As String ' Const NAZWA_METODY As String = "onlyLetters" ' '------------------------------------------------------------------------------------------------------------------- ' Const ASC_SPACE As Integer = 32 ' Const ASC_A_LOW As Integer = 97 ' Const ASC_Z_LOW As Integer = 122 ' Const ASC_A_UPPER As Integer = 65 ' Const ASC_Z_UPPER As Integer = 90 ' Const LOCAL_CHARS As String = "|138|140|141|142|143|" & _ ' "154|156|157|158|159|163|165|170|175|179|181|" & _ ' "185|186|188|190|191|192|193|194|195|196|197|" & _ ' "198|199|200|201|202|203|204|205|206|207|208|" & _ ' "209|210|211|212|213|214|216|217|218|219|220|" & _ ' "221|222|223|224|225|226|227|228|229|230|231|" & _ ' "232|233|234|235|236|237|238|239|240|241|242|" & _ ' "243|244|245|246|248|249|250|251|252|253|254|" ' '------------------------------------------------------------------------------------------------------------------- ' Dim intChar As Integer ' Dim strChar As String ' Dim intAsc As Integer ' '------------------------------------------------------------------------------------------------------------------- ' ' ' For intChar = 1 To VBA.Len(tekst) ' strChar = VBA.Mid$(tekst, intChar, 1) ' intAsc = VBA.Asc(strChar) ' ' If intAsc >= ASC_A_LOW And intAsc <= ASC_Z_LOW Then ' 'Lower case letters ' onlyLetters = onlyLetters & strChar ' ElseIf intAsc >= ASC_A_UPPER And intAsc <= ASC_Z_UPPER Then ' 'Upper case letters ' onlyLetters = onlyLetters & strChar ' ElseIf VBA.InStr(1, LOCAL_CHARS, "|" & intAsc & "|", vbBinaryCompare) Then ' 'Local characters ' onlyLetters = onlyLetters & strChar ' ElseIf leaveSpaces And intAsc <= ASC_SPACE Then ' 'White spaces. ' onlyLetters = onlyLetters & strChar ' End If ' ' Next intChar ' 'End Function ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: trimText '' Autor: mielk | 2013-05-16 '' '' Opis: Removes all excessive spaces from the given tekst. '' '' Argumenty: '' tekst String to be trimmed. '' leading Determines if leading spaces should be removed. '' trailing Determines if trailing spaces should be removed. '' excessive Determines if excessive spaces in the middle of the string '' should be removed. '' '' Zwraca: '' String The original string after removing all the letters. '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function trimText(tekst As String, leading As Boolean, _ ' trailing As Boolean, excessive As Boolean) As String ' Const NAZWA_METODY As String = "trimText" ' '------------------------------------------------------------------------------------------------------------------- ' Dim strTrimmed As String ' '------------------------------------------------------------------------------------------------------------------- ' ' ' If excessive Then ' ' strTrimmed = Excel.WorksheetFunction.Trim(tekst) ' ' 'If leading spaces are not to be removed, they are appended to the ' 'result string [trimText]. ' If Not leading Then _ ' trimText = VBA.String$(howManyChars(tekst, " "), " ") ' ' trimText = trimText & strTrimmed ' ' 'If trailing spaces are not to be removed, they are appended to the ' 'result string [trimText]. ' If Not trailing Then trimText = trimText & _ ' VBA.String$(howManyChars(tekst, " ", True, False), " ") ' ' Else ' ' 'trimText variable is initialized with the value of source tekst. ' trimText = tekst ' ' If leading Then trimText = VBA.LTrim(trimText) ' If trailing Then trimText = VBA.RTrim(trimText) ' ' End If ' 'End Function ' ' ' ''[4Export]'[@uid:]'[@name:]'[@keywords:vba functions arrays]'[@tooltip:Function to ] ''********************************************************************************************************** '' Nazwa: howManyChars '' Autor: mielk | 2013-05-16 '' '' Opis: Function checks how many times the specified character (or '' string of characters) is repeated at the beginning or at '' the end of the given source tekst. '' '' Argumenty: '' tekst Source tekst. '' znak Character or group of characters that occurrencess at the '' beginning of the source string are to be counted. '' If this is empty string, 0 is returned. '' wielkoscZnakowMaZnaczenie '' Optional parameter of Boolean type. '' It determines if tekst matching is case sensitive. '' If this value is set to True, searching is case sensitive - '' a letter in lowercase is treated as different than the same '' letter in uppercase (i.e. a <> A). '' If this value is set to False, it doesn't matter if a '' letter is in lowercase or in uppercase, since both of them '' are considered as the same character (i.e. a = A). '' Default value of this parameter is True. '' fromStart Optional parameter of Boolean type. It defines if '' characters at the beginning (if this parameter is set to '' True) or at the end (if it is set to False) of the source '' tekst are counter. '' Default value for this parameter is True. '' '' Zwraca: '' Integer The number of occurrence of the specified character or '' group of characters at the beginning or at the end of the '' given source tekst. '' '------------- '' Examples: '' ?howManyChars("aaab", "a") = 3 '' Character "a" is repeated three times at the beginning '' of the source tekst aaab. '' ?howManyChars("abcabcdabc", "abc") = 2 '' String "abc" is repeated two times at the beginning '' of the source tekst abcabcdabc. '' ?howManyChars("abc ", " ", true, false) = 3 '' Character " " (white space) is repeated three times at '' the end of the source tekst abc (parameter fromStart '' is set to False, that is why we analyze the end of the '' source tekst this time). '' '' '' --- Zmiany ---------------------------------------------------------------------------------------------- '' 2013-05-16 mielk Utworzenie funkcji. ''********************************************************************************************************** 'Public Function howManyChars(tekst As String, znak As String, _ ' Optional wielkoscZnakowMaZnaczenie As Boolean = True, _ ' Optional fromStart As Boolean = True) As Integer