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):Sub proba()
Dim matrica() As Variant
ReDim matrica(1 To 1, 1 To 1)
Dim startDatum As Date
Dim endDatum As Date
startDatum = "2.1.2015."
endDatum = "5.1.2015."
ActiveSheet.Range("B1").Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
Set rangDatum = Selection 'stavim red datuma u rangDatum
Dim maxRed As Integer
maxRed = Range("A2").End(xlDown).Row 'max broj redova dakle od A2 do A5
Dim celija As Range
For red = 2 To maxRed 'krece od drugod reda do maxRedova
For Each celija In rangDatum 'koja celija u rangu datuma
If celija >= startDatum And celija <= endDatum Then 'ima vrijednost
If red <= 2 Then 'ako je red prvi koji uzimamo u matricu
kolona = celija.Column - 2 'stavimo kolonu na 1 zato da stavlja u matricu od prvog mjesta
ReDim Preserve matrica(1 To red - 1, 1 To kolona) ' redimenzioniranje, povecamo drugu za kolonu tj +1
matrica(red - 1, kolona) = Cells(red, celija.Column) 'ubacimo u matricu(red,celija.column) celija.column=kolona celija koja ispunjava uvijet
Else
'ako nije pocetak tj red 2 onda vise ne redimenzioniramo matricu
kolona = celija.Column - 2
matrica(red - 1, kolona) = Cells(red, celija.Column)
End If
End If
Next celija
If red < maxRed Then'ako red nije dostigao max vrijednost
matrica = Application.Transpose(matrica)' transponse = transportiram matricu(2,8) u matrica(8,2)
ReDim Preserve matrica(1 To kolona, 1 To red),'da bi mogao redimenzionirati posljednju dimenziju
matrica = Application.Transpose(matrica)' transportiram nazad matrica(8,3) u matrica(3,8)
Else
red = red + 1 'ako je red dostigao maxRed povecavamo red na max da bi izasli iz petlje
'mogli smo i staviti goto
End If
Next red
'ispis matrice, a moze biti i u list ovdje je u immediate prozor
For red = 1 To maxRed - 1
For kolona = 1 To UBound(matrica, 1)
Debug.Print Cells(red + 1, 1) & "(" & red & "," & kolona & ")" & matrica(red, kolona)
Next kolona
Next red
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.