Prikazi cijelu temu 14.06.2015 12:16
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Lokacija:zagreb


Predmet:Re: vba excel dim redim preserve matrica
uhuhuhuuu, dakle bilo problema sa ovim dok nisam otkrio ovo:
"kod redimenzioniranja vise dimenzionalne matrice, mozete redimenzionirati, povecati samo posljednju dimenziju matrice"
u praksi je to ovako:

dim matrica(10,10)

ovo mozemo
redim matrica(10,20)

ali ovo ne mozemo
redim matrica(20,10)

dakle gubitak od cirka 4 dana dok sam banalnu stvar otkrio. Sigurno ste se zabavljali dok ste razmisljali o meni i mojim mukama. heheheh


image uploading
to sam onda rijesio ovako:

PreuzmiIzvorni kôd (Visual Basic):
  1. Sub proba()
  2.     Dim matrica() As Variant
  3.     ReDim matrica(1 To 1, 1 To 1)
  4.    
  5.     Dim startDatum As Date
  6.     Dim endDatum As Date
  7.     startDatum = "2.1.2015."
  8.     endDatum = "5.1.2015."
  9.        
  10.     ActiveSheet.Range("B1").Select
  11.     ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
  12.     Set rangDatum = Selection 'stavim red datuma u rangDatum
  13.    Dim maxRed As Integer
  14.     maxRed = Range("A2").End(xlDown).Row 'max broj redova dakle od A2 do A5
  15.    Dim celija As Range
  16.  
  17.     For red = 2 To maxRed 'krece od drugod reda do maxRedova
  18.        For Each celija In rangDatum 'koja celija u rangu datuma
  19.            If celija >= startDatum And celija <= endDatum Then 'ima vrijednost
  20.                If red <= 2 Then 'ako je red prvi koji uzimamo u matricu
  21.                    kolona = celija.Column - 2 'stavimo kolonu na 1 zato da stavlja u matricu od prvog mjesta
  22.                    ReDim Preserve matrica(1 To red - 1, 1 To kolona) ' redimenzioniranje, povecamo drugu za kolonu tj +1
  23.                    matrica(red - 1, kolona) = Cells(red, celija.Column) 'ubacimo u matricu(red,celija.column) celija.column=kolona celija koja ispunjava uvijet
  24.                Else
  25.                     'ako nije pocetak tj red 2 onda vise ne redimenzioniramo matricu
  26.                    kolona = celija.Column - 2
  27.                     matrica(red - 1, kolona) = Cells(red, celija.Column)
  28.                 End If
  29.             End If
  30.         Next celija
  31.         If red < maxRed Then'ako red nije dostigao max vrijednost
  32.            matrica = Application.Transpose(matrica)' transponse = transportiram matricu(2,8) u matrica(8,2)
  33.            ReDim Preserve matrica(1 To kolona, 1 To red),'da bi mogao redimenzionirati posljednju dimenziju
  34.            matrica = Application.Transpose(matrica)' transportiram nazad matrica(8,3) u matrica(3,8)
  35.        Else
  36.             red = red + 1 'ako je red dostigao maxRed povecavamo red na max da bi izasli iz petlje
  37.                           'mogli smo i staviti goto
  38.        End If
  39.     Next red
  40.         'ispis matrice, a moze biti i u list ovdje je u immediate prozor
  41.    For red = 1 To maxRed - 1
  42.         For kolona = 1 To UBound(matrica, 1)
  43.             Debug.Print Cells(red + 1, 1) & "(" & red & "," & kolona & ")" & matrica(red, kolona)
  44.         Next kolona
  45.     Next red
  46. End Sub

ispis u immediate:
ivo(1,1)kruska
ivo(1,2)sljiva
ivo(1,3)tresnja
ivo(1,4)visnja
luka(2,1)sljiva
luka(2,2)tresnja
luka(2,3)visnja
luka(2,4)jagoda
mirko(3,1)tresnja
mirko(3,2)visnja
mirko(3,3)jagoda
mirko(3,4)lubenica
slavko(4,1)visnja
slavko(4,2)jagoda
slavko(4,3)lubenica
slavko(4,4)krumpir
zivot je moja domovina.