[ mirko1949 @ 07.04.2010. 10:24 ] @
| Probao sam nesto da na osnovu podataka (anketa) koje bi mi slali drugi korisnici izvrsim obradu rezultata. Na Netu sam nasao nesto sto bi moglo da mi odgovara, ali nisam uspeo. To sto sam nasao je sledece i moze se pogledati i ovde: http://excelancije.bloger.hr/p...ao-anketni-upitnik/105973.aspx Kod glasi: Sub GetData() Application.ScreenUpdating = False Dim bk As Workbook, rng As Range Dim rng1 As Range, sPath As String Dim icol As Long, sName As String sPath = "C:\Anketa\" sName = Dir(sPath & "*.xls") icol = 1 Do While sName <> "" Set bk = Workbooks.Open(sPath & sName) Set rng = bk.Worksheets("sheet1").Range("A1:A10") Set rng1 = ThisWorkbook.Worksheets(1).Cells(1, icol) rng.Copy rng1.Offset(1, 0) icol = icol + 1 bk.Close Savechanges:=False sName = Dir() Loop Application.ScreenUpdating = True End Sub Sve što treba učiniti je kreirati folder C:\Anketa\ i u njega potrpati sve upitnike koje su vratili vaši ispitanici. Nakon toga u sumarnom workbooku potrebno je kopirati ovaj kod u novi modul i pokrenuti makro, koji prebacije rezultate iz Sheet1!A1:A10 u stupce workbooka iz kojeg izvršavamo kod. Tamo možemo postaviti obradu rezultata kakvu želimo. Sve ovo sam primenio na moj slucaj ali ne funkcionise. Naime, kada pokrenem makro celije u sumarnom listu ostaju prazne. Ne javlja ni gresku. Moze li mi neko pomoci? |