...res sem napisal bol malo
![Sad :(](./images/smilies/icon_sad.gif)
.
Zadevo imam v Excelu 2003. Proceduro sem malo izpopolnil za nekom, ki je vse podatke vnašal ročno. Res se nisem ne vem kako potrudu - ampak dela. Zgleda pa tako:
Koda: Izberi vse
Sub Macro1()
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("PodatkiIn").Activate
For Each c In Range("C5:C20")
If c.Value = "" Then GoTo Preskok
mapa = ThisWorkbook.Path & "\"
datoteka = c.Offset(0, 0).Value
sheet_podatki_In = CStr(c.Offset(0, 1))
od_frekvence = c.Offset(0, 2).Value
do_frekvence = c.Offset(0, 3).Value
'odpri txt
Workbooks.OpenText Filename:= _
mapa & datoteka _
, Origin:=-535, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
'
vrstica_1 = Columns("G:G").Find(What:=od_frekvence).Row
vrstica_2 = Columns("G:G").Find(What:=do_frekvence).Row - 1
'spucaj odložišče
Workbooks(ThisWorkbook.Name).Worksheets(sheet_podatki_In).Range("A5:D5000").ClearContents
'kopiraj
Range("C" & vrstica_1 & ":F" & vrstica_2).Copy
'odloži
Workbooks(ThisWorkbook.Name).Worksheets(sheet_podatki_In).Range("A5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'zapri txt
ActiveWorkbook.Close SaveChanges:=False
Worksheets(sheet_podatki_In).Select
'SOLVER
SolverOk SetCell:="$L$6", MaxMinVal:=3, ValueOf:="0", ByChange:="$L$3:$L$5"
SolverSolve True
SolverOk SetCell:="$K$6", MaxMinVal:=3, ValueOf:="0", ByChange:="$K$3:$K$5"
SolverSolve True
'
Worksheets("PodatkiIn").Select
Preskok:
Next
End Sub
Lp