Niekaip neprisiversciau parasyti tiek kometaru :)

pagarba



"Juozas V." <vjuozas@istrinti.gmail.com> wrote in message 
news:1n55k6l5tesmes9c8fqusu78eug3qvdicp@4ax.com...
> On Fri, 28 Jan 2011 09:08:54 +0200, "Mindaugas" <nera@mailo.com> wrote:
>
>>Va cia tai ko reikia, didelis ACIU, bet ....  su mavo kukliom ziniom 
>>nepavyko perprasti kas, kur kaip ir kodel :((( o perprasti noretusu, kad 
>>galeciau ir kitokio tipo lentelej pritaikyti, ar elementariai iterpti 
>>stulpeli ar eilute...
>>
> Bandau pridėti komentarus ;)
>
> Type rws ' aprašo būsimos lentelės tipą
>  a As String
>  b As String
>  c As Variant
> End Type
>
> Sub SumUnique()
>  Dim LastRow As Long, MyRow As Long ' Last Row - paskutinė duomenų eilutė, 
> MyRow - skaičiuojama
>  Dim duom1 As String, duom2 As String, duom3 ' - nuskaitomi duomenys
>  Dim Result() As rws ' Lentelė, kurią procedūros pabaigoje išvedame į 
> ekraną
>  Dim n, i, Prideti As Boolean 'pagalbiniai kintamiejai
>  Application.ScreenUpdating = False ' išjungia ekrano perpiešimą ( 
> teoriškai turėtų būti greičiau atliekama procedūra)
>  n = 2
>  Prideti = True
>  LastRow = Range("A" & Rows.Count).End(xlUp).Row suranda paskutinę 
> lentelės eilutę. Atitinka, jei pasižymėtai paskutinę Sheeto celę
> (A65536), po to paspaustai "End" ir rodyklę į viršų
>  For MyRow = 2 To LastRow ' nuo antros iki paskutinės eilutės
>    duom1 = Cells(MyRow, 1).Value ' Nuskaito reikšmes A, B ir C 
> stulpeliuose
>    duom2 = Cells(MyRow, 2).Value
>    duom3 = Val(Cells(MyRow, 3).Value) ' Val funkcija paverčia skaičiumi 
> tekstinį įrašą. Jei bus "123A" gausi 123, jei "A123" ar "AA" tai 0
>    If MyRow = 2 Then 'jei eilutės nr. 2
>      ReDim Result(2 To 2) 'aktyvuoja lentelę Result
>      Result(2).a = duom1 ' ir surašo antros eilutės duomenis
>      Result(2).b = duom2
>      Result(2).c = duom3
>    Else ' jei eilutės numeris ne 2
>      For i = 2 To n ' tikrina A ir B stulpelio reikšmes su lentelės 
> reikšmėm
>        If (duom1 = Result(i).a) And (duom2 = Result(i).b) Then' jei randa 
> sutampančius
>          Result(i).c = Result(i).c + duom3 ' tai priplisuoja C stulpelio 
> reikšmę prie esamos
>          Prideti = False ' pakeičia kintamojo Prideti reikšmę (nebus 
> naujos eilutės lentelėje )
>          Exit For ' nutraukia procedūrą For (nebūtina eilutė, truputį 
> pagreitina darbą)
>        End If
>      Next i
>        If Prideti = True Then 'jei nebuvo rasta sutapimų
>          n = n + 1
>          ReDim Preserve Result(2 To n) 'prideda eilutę Result lentelėje
>          Result(n).a = duom1 ' ir surašo nuskaitytas reikšmes
>          Result(n).b = duom2
>          Result(n).c = duom3
>        End If
>        Prideti = True ' pakeičia Prideti reikšmę į pradinę
>    End If
>  Next MyRow
>  Range("A2:C" & LastRow).Delete ' ištrina duomenų lentelę
>  For MyRow = 2 To n ' ir surašo į tą vietą naujus duomenis iš Result()
>    Cells(MyRow, 1).Value = Result(MyRow).a
>    Cells(MyRow, 2).Value = Result(MyRow).b
>    Cells(MyRow, 3).Value = Result(MyRow).c
>  Next MyRow
>  Application.ScreenUpdating = True ' Įjungia ekrano perpiešimą
> End Sub ' Ir viskas