to moze da se uradi pomocu nizova ali moze i pomocu klasa i kolekcije (objekata) klasa isto.
na primer, podaci se pokupe sa svih sheetova i ubace u kolekciju klasa i nako tkz. uvoza podataka se onda odradi sta treba i posle obradjeni podaci vrate na postojeci i novi sheet.
sa klasama je podrobnije opisivanje podataka i lakse gledano iz ljudsko ugla.
takodje isto moze recimo da se namerno kroz kod ide na gresku prilikom dodavanja objekta u kolekciju kada se koristi jedinstveni kljuc u kolekciji za svaki zapis koji se dodaje i da pritom zbog duplikata kada dodje do greske ista se ignorise... i tako dobije jedinstvena lista.
recimo key: 'Garancija 1 T-12546'
dole evo primer gde se koristi jedna klasa i nesto koda.
ovo je samo primer koji se moze prilagoditi da bude neogranicen broj banaka tako sto bi se deo oko provere uslova ispravio i odradio na drugi nacin.
Kod za 'Class Modules'
Name: cZapis
Code:
Private mBroj As String
Private mTender As String
Private mBanka As String
Private mB1 As Long
Private mB2 As Long
Private mB3 As Long
Public Property Let Broj(ByVal vData As String)
mBroj = vData
End Property
Public Property Get Broj() As String
Broj = mBroj
End Property
Public Property Let Tender(ByVal vData As String)
mTender = vData
End Property
Public Property Get Tender() As String
Tender = mTender
End Property
Public Property Let Banka(ByVal vData As String)
mBanka = vData
End Property
Public Property Get Banka() As String
Banka = mBanka
End Property
Public Function GetKey() As String
GetKey = mBroj & " " & mTender
End Function
Public Property Let B1(ByVal vData As Long)
mB1 = vData
End Property
Public Property Get B1() As Long
B1 = mB1
End Property
Public Property Let B2(ByVal vData As Long)
mB2 = vData
End Property
Public Property Get B2() As Long
B2 = mB2
End Property
Public Property Let B3(ByVal vData As Long)
mB3 = vData
End Property
Public Property Get B3() As Long
B3 = mB3
End Property
Public Function GrandTotal() As Long
GrandTotal = mB1 + mB2 + mB3
End Function
Primer koda koji:
- kreira listu svih zapisa iz INF sheet-a
- kreira potom jedinstvenu listu tendera i
- potom kreira posle statistiku po bankama
Code:
Private Sub CreateList(ByRef ThisSheet As Excel.Worksheet, _
ByRef ThisList As Collection, _
Optional ByVal iStartFromRow As Long = 2, _
Optional IsUniqueList As Boolean = False)
Dim i As Long
Dim iTotalRows As Long
Dim sKey As String
Dim xItem As cZapis
' Get total rows in sheet
iTotalRows = ThisSheet.Cells(ThisSheet.Rows.Count, 1).End(xlUp).Row
' Go over rows in sheet
For i = iStartFromRow To iTotalRows
' Create new instance of object
Set xItem = New cZapis
' Assign values from sheet to class object
With xItem
.Broj = Cells(i, 1)
.Tender = Cells(i, 2)
.Banka = Cells(i, 3)
sKey = .GetKey
End With
' If we are not creating unique list then
If IsUniqueList = False Then
' Add item to collection
ThisList.Add xItem
' If we are creating unique list then
Else
On Error Resume Next
' Add item to collection with unique key
ThisList.Add xItem, sKey
' If there was any error (guess item with same key already exists) then
If Err.Number <> 0 Then
' Notification to user
Debug.Print "Item with same key already exists.", sKey
Err.Clear
End If
End If
Next
' Notification about total number of items in list
Debug.Print "Total items in list: " & ThisList.Count
End Sub
Public Sub LetsDoit()
Dim xData As Collection
Dim xList As Collection
Dim xItem As cZapis
Dim sKey As String
Set xList = New Collection
Set xData = New Collection
' INF - Sheet4
CreateList Sheet4, xData
' Create unique list
CreateList Sheet4, xList, , True
' Update counters for each bank in unique tender list
For Each xItem In xData
With xItem
' Get unique tender key
sKey = .GetKey
' Update counters if bank value match to bellow values
Select Case .Banka
Case "B1": xList.Item(sKey).B1 = xList.Item(sKey).B1 + 1
Case "B2": xList.Item(sKey).B2 = xList.Item(sKey).B2 + 1
Case "B3": xList.Item(sKey).B3 = xList.Item(sKey).B3 + 1
End Select
End With
Next
' Dump list to immediate window for review - this can be used to dump data in to (new) worksheet
For Each xItem In xList
With xItem
Debug.Print .Broj, .Tender, .B1, .B2, .B3, .GrandTotal
End With
Next
' Free memory resource
Set xItem = Nothing
Set xData = Nothing
Set xList = Nothing
End Sub
Dole u nastavku uzorak koji se dobija u immediate prozoru u VBA
Code:
Total items in list: 49
Item with same key already exists. Garancija 1 T-12546
Total items in list: 48
Garancija 1 T-12546 1 0 1 2
Garancija 2 T-12547 1 0 0 1
Garancija 3 T-12548 1 0 0 1
Garancija 4 T-12549 1 0 0 1
Garancija 5 T-12550 1 0 0 1
Garancija 6 T-12551 1 0 0 1
Garancija 7 T-12552 1 0 0 1
Garancija 8 T-12553 1 0 0 1
Garancija 9 T-12554 1 0 0 1
Garancija 10 T-12555 1 0 0 1
Garancija 11 T-12556 1 0 0 1
Garancija 12 T-12557 1 0 0 1
Garancija 13 T-12558 1 0 0 1
Garancija 14 T-12559 1 0 0 1
Garancija 15 T-12560 1 0 0 1
Garancija 16 T-12561 1 0 0 1
Garancija 17 T-12562 1 0 0 1
Garancija 18 T-12563 1 0 0 1
Garancija 19 T-12564 1 0 0 1
Garancija 20 T-12565 1 0 0 1
Garancija 21 T-12566 1 0 0 1
Garancija 1 T-52154 0 1 0 1
Garancija 2 T-52155 0 1 0 1
Garancija 3 T-52156 0 1 0 1
Garancija 4 T-52157 0 1 0 1
Garancija 5 T-52158 0 1 0 1
Garancija 6 T-12554 0 1 0 1
Garancija 7 T-52160 0 1 0 1
Garancija 8 T-52161 0 1 0 1
Garancija 9 T-52162 0 1 0 1
Garancija 10 T-52163 0 1 0 1
Garancija 11 T-52164 0 1 0 1
Garancija 12 T-52165 0 1 0 1
Garancija 2 T-51245 0 0 1 1
Garancija 3 T-51246 0 0 1 1
Garancija 4 T-51247 0 0 1 1
Garancija 5 T-51248 0 0 1 1
Garancija 6 T-51249 0 0 1 1
Garancija 7 T-51250 0 0 1 1
Garancija 8 T-51251 0 0 1 1
Garancija 9 T-51252 0 0 1 1
Garancija 10 T-51253 0 0 1 1
Garancija 11 T-51254 0 0 1 1
Garancija 12 T-51255 0 0 1 1
Garancija 13 T-51256 0 0 1 1
Garancija 14 T-51257 0 0 1 1
Garancija 15 T-51258 0 0 1 1
Garancija 16 T-51259 0 0 1 1