Evo brzinskog resenje posto nije sve bas definisano ali opet sasvim dovoljno da se odradi do kraja i implementiran sta se hoce.
Bitno je da se odradi ono sto sam naveo na pocetku sto se tice sistemskih podesavanja da bi moglo da se radi sa nasim slovima u VBA posto isti ne podrzava UTF-8 i Unicode na nacin kako se sada radi i praktikuje.
U prilogu je Excel file sa VBA kodom koji se takodje nalazi dole kao text.
Pored toga su i dva screenshot cisto eto da se vidi da kod radi.
Odradjena su dva primera i nacina kako se proverava vrednost, kao BOOL i kao VALUE.
Trenutno je postavljen primer da radi sa VALUE varijantom ali je ostavljen i BOOL samo iskljucen u kodu.
BOOL primer vraca TRUE ili FALSE za vrednost, VALUE primer vraca odgovarajucu vrednost, ako nema tj. FALSE onda vraca podrazumevanu vrednost koja se isto moze predefinisati prilikom pozivanja iste.
Ovde nasa slova nece biti prikazana kako treba.
Vrednosti su:
Tačno -> Òà÷íî
Nije tačno -> Íè¼å òà÷íî
Code:
Sub DoTask4Me()
' Before use this code you should apply changes in to system settings
' Control Panel -> Region and Language
' In 'Administrative' tab, section 'Language for non-Unicode programs', click on button 'Change system locale...'
' Select 'Serbian (Cyrlic, Serbia)
' After applying this, workstation should be restarted!
' Same process goes and for Serbian (Latin, Serbia)
' Only one at time can be used.
' Notes: In some cases maybe will ask for Windows OS install media to collect files which are missing.
Dim pSheet As Worksheet
Dim mSifarnik As Collection
Dim i As Integer
Dim iCol As Integer
Dim iTotalRows As Long
Dim iValueCol As Integer
Set pSheet = ActiveWorkbook.ActiveSheet
' --> Example of creating unique list of values which should be checked <--
' Column number for unique list of values in sheet
iCol = 9
' Create new instance of object
Set mSifarnik = New Collection
' Create 'Sifarnik' where item key is value from cell and value of item in collection is value which will be set as return value of checking function
With mSifarnik
' Add item to collection
.Add "Òà÷íî", Cells(2, iCol)
' Add item to collection
.Add "Òà÷íî", Cells(3, iCol)
End With
' --> Example of going over list of cells and check items for values and set appropriate value <--
' Get total number of rows in sheet
iTotalRows = pSheet.UsedRange.Columns(1).Rows.Count
' Set value to column
iValueCol = 5
For i = 2 To iTotalRows
' ' Version 1 -- Using bool function for checking item
' ' If item is present in list then
' If IsItemPresentBool(mSifarnik, pSheet.Cells(i, 4)) = True Then
'
' ' Set value in cell
' pSheet.Cells(i, iValueCol) = "Òà÷íî"
'
' ' If item isn't present in list then
' Else
'
' ' Set value in cell
' pSheet.Cells(i, iValueCol) = "Íè¼å òà÷íî"
'
' End If
' Version 2 -- Using return as value set function for checking item
pSheet.Cells(i, iValueCol) = IsItemPresentValue(mSifarnik, pSheet.Cells(i, 4))
Next
' Free memory resource
Set mSifarnik = Nothing
Set pSheet = Nothing
End Sub
' Version 1
Private Function IsItemPresentBool(ByRef ThisCol As Collection, ByRef ThisValue As String) As Boolean
On Error Resume Next
Dim r As String
' Try to get item from collection
r = ThisCol.Item(ThisValue)
' If there any error e.g. not present then
If Err.Number <> 0 Then
Err.Clear
' Return value
IsItemPresentBool = False
Else
' Return value
IsItemPresentBool = True
End If
End Function
' Version 2
Private Function IsItemPresentValue(ByRef ThisCol As Collection, ByRef ThisValue As String, Optional ByVal ReturnDefaultValue As String = "Íè¼å òà÷íî") As String
On Error Resume Next
Dim r As String
' Try to get item from collection
r = ThisCol.Item(ThisValue)
' If there any error e.g. not present then
If Err.Number <> 0 Then
Err.Clear
' Return value
IsItemPresentValue = ReturnDefaultValue
Else
' Return value
IsItemPresentValue = r
End If
End Function