Prikazi cijelu temu 27.12.2016 13:16
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Lokacija:zagreb


Predmet:Re: kretanje po stupcima uz pomoc for next petlje
evo ja mislim da je to to

naslov svake kolone je datum, koji nije sortiran, ispod je vrsta (voce/povrce) i onda podaci
1.1.5.1.2.1.4.1.3.11.2.5.2.2.2.4.2.3.2.
vocevocevocevocevocepovrcepovrcepovrcepovrcepovrce
jabukajabukakruskabanananarandarajcicamahunegrasakmrkvakrumpir
kruskabananajabuka  mahune mrkvakrumpir 
 itd        

treba sortirati po datumu, ali da ostane redoslijed voce pa onda povrce

PreuzmiIzvorni kôd (Visual Basic):
  1. Sub slaganjeVrsta()
  2.     'aktivni List
  3.    Dim aktivniList As String
  4.     aktivniList = ActiveSheet.Name
  5.     Range("A1").Select
  6.    
  7.     'odredivanje prve kolone i zadnje kolone
  8.    Dim prvaKolona As Long
  9.     Dim zadnjaKolona As Long
  10.     Range("B1").Select
  11.     prvaKolona = 2
  12.     zadnjaKolona = traziZadnjuKolonu(aktivniList)
  13.    
  14.     Dim arrVrsta() As Variant
  15.     Dim i As Long
  16.     ReDim Preserve arrVrsta(i)
  17.     arrVrsta(i) = Cells(2, 2)
  18.     'stvaranje matrice bez ponavljanja
  19.    For c = prvaKolona To zadnjaKolona
  20.         If arrVrsta(i) <> Cells(2, c) Then
  21.             i = i + 1
  22.             ReDim Preserve arrVrsta(i)
  23.             arrVrsta(i) = Cells(2, c)
  24.         End If
  25.     Next c
  26.     'matrica ima vrijednost arrVrsta(0)=voce i arrVrsta(1)=povrce
  27.    i = 0
  28.        
  29.     For c = 2 To zadnjaKolona
  30.         'u svakom stupcu trazimo max broj redova
  31.        If zadnjiSortRed < traziZadnjiRed(aktivniList, c) Then
  32.             zadnjiSortRed = traziZadnjiRed(aktivniList, c)
  33.         End If
  34.         If i < Ubound(arrVrsta) Then 'ako petlja nije dosla do zadnje vrijednosti matrice
  35.            If Cells(2, c) = arrVrsta(i) Then 'ako je celija vrijednosti matrice npr voce=voce
  36.                prvaSortKolona = c               'uzimamo broj kolone za pocetak ranga
  37.                i = i + 1
  38.             Else                                       'ako celija nema vrijednost matrice npr voce<>povrce
  39.                zadnjaSortKolona = c            'uzimamo broj kolone za kraj ranga
  40.                If Cells(2, c + 1) = arrVrsta(i) Then
  41.                     Range(Cells(1, prvaSortKolona), Cells(zadnjiSortRed, zadnjaSortKolona)).Select
  42.                     'sortiranje
  43.                    Range(Cells(1, prvaSortKolona), Cells(zadnjiSortRed, zadnjaSortKolona)).Sort _
  44.                         Key1:=Range(Cells(1, 2), Cells(1, zadnjaSortKolona)), _
  45.                         Order1:=xlAscending, _
  46.                         Orientation:=xlLeftToRight
  47.                     prvaSortKolona = c
  48.                 End If
  49.             End If
  50.         Else
  51.             If c = zadnjaKolona Then
  52.                 Range(Cells(1, prvaSortKolona), Cells(zadnjiSortRed, zadnjaKolona)).Select
  53.                 'sortiranje
  54.                Range(Cells(1, prvaSortKolona), Cells(zadnjiSortRed, zadnjaKolona)).Sort _
  55.                         Key1:=Range(Cells(1, 2), Cells(1, zadnjaKolona)), _
  56.                         Order1:=xlAscending, _
  57.                         Orientation:=xlLeftToRight
  58.             End If
  59.         End If
  60.     Next c
  61. End Sub
  62.  
  63. Function traziZadnjiRed(ImeSita As String, kolona)
  64.     Dim Zadnji As Long
  65.     Dim ws As Worksheet
  66.    
  67.     Set ws = Sheets(ImeSita)
  68.     With ws
  69.         Zadnji = .Cells(.Rows.Count, kolona).End(xlUp).Row
  70.     End With
  71.     traziZadnjiRed = Zadnji
  72. End Function
  73.  
  74. Function traziZadnjuKolonu(ImeSita As String)
  75.     Dim Zadnji As Long
  76.     Dim ws As Worksheet
  77.     Set ws = Sheets(ImeSita)
  78.     With ws
  79.         Zadnji = .Cells(1, .Columns.Count).End(xlToLeft).Column
  80.     End With
  81.     traziZadnjuKolonu = Zadnji
  82. End Function

OVO KOD MENE, ZA SADA, RADI.
Kada ovom budem gledao za mjesec dana necu znati cemu sluzi ni kako radi.
vec mi se desavalo da trebam neku stvar ponovo upotrijebiti pa nisam znao i napravio sam ponovo, a ispalo je sasvim drugacije i isto radi
jbg
zivot je moja domovina.
Ovaj post je ureden 5 puta. Posljednja izmjena 27.12.2016 13:32 od strane Avko.