Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu

[ ramzesIV @ 27.02.2012. 11:24 ] @

Pozdrav!

Hocu da napisem Public Function

u jednoj koloni su mi datumi. u drugoj brojevi.

1. poslenjdnji dan trazim nekako pomocu:

Code:

Dim LastDayinMonth as date
dim mDate as date

if mDate=0 Then mDate = Date
End If
LastDayinMonth = DateSerial(Year(mDate), Month(mDate) + 1, 0)

2. sad bih sa Offset.(0,1) recimo

Code:

Dim J As Integrer
ako je LastDayinMonth onda sa offset da uzme drugi broj i da to bude npr J

ili LastDayinMonth = Offset(0,1)

uglavnom to bi izgledalo u excelu da celi mesec (30 dana) bude isti broj.

3. onda recimo za definisem Per koje bi bilo Per = (J / J-1)-1

4. i na kraj definisem PerMin. ako je Per<(Per-1) onda je to PerMin

da napomenem da kao pokusavam da se vodim

sa jednim makroom koji me je ovde vec neko pomogao da rezultat bude tacan,

http://www.elitesecurity.org/t363191-vba-code-max-drawdown

ali mi ne ide nikako sa ovim offset ili find ili vec sta treba.

pa, ako neko ima vremena, ...

[ ramzesIV @ 27.02.2012. 12:13 ] @

na primer u A1 je 25.02.2012 u A2 je 26.02.2012, i to ova funkcija LastDayinMonth vidi kao 29.02.2012 i onda sa ofset (ili nekom drugom funkcijom) trazi drugi kolonu.

A B
25.02.2012 25,2
26.02.2012 28,5
...
29.02.2012 60,0
...
25.03.2012 65,3
26.03.2012 66,3
...
31.03.2012 70,0

a ja hocu sa makroom:

A B
25.02.2012 60,0
26.02.2012 60,0
...
29.02.2012 60,0
...
25.03.2012 70,0
26.03.2012 70,0
...
31.03.2012 70,0

i onda:

[ Jpeca @ 27.02.2012. 12:24 ] @

Ako u trećoj koloni upišeš

Code:
=VLOOKUP(EOMONTH(A1;0);tblPrimer;2;FALSE)

dobiceš cifre koje si navela u primeru

[ ramzesIV @ 27.02.2012. 12:29 ] @

u excelu to i radim sad. ali problem je sto imam ovakve dve kolone puta 130. i svake nedelje se povecava.
i svaki put moram manuelno da apdejtujem, pa ja sad hocu funkciju da napisem, koja bi to radila sama.

u stvari meni i treba samo EOMONTH i koji bi trazio broj u koloni B. B je recimo definisano u makrou kao J

i onda (J/(J-1))-1 = recimo "Per"

[ Jpeca @ 27.02.2012. 12:52 ] @

Ako koristiš tabelu dovanjem novih redova na dno tabele, formula u trećoj koloni se automatski dodaje tako da tu ne vidim problem.

[ ramzesIV @ 27.02.2012. 12:58 ] @

ne novih redova, vec novih kolona. tako da je svake nedelje +2. 130, 132, ...

eh da je redova, ne bih bilo strasno.

[ Jpeca @ 27.02.2012. 13:08 ] @

Nije problem da se napravi makro, ali ne vidim kako bi tu korisnička funkcija pomogla. Gornja formula je jednostavna i lako je kopirati. Eventualno makro - procedura koja bi izvršila zamenu vrednosti ali opišti onda šta tačno treba

Da li dodaješ kolonu sa novim vrednostima (kao korisnička funkcija) ili treba da zameniš postojeće vrednosti u koloni?

Da li to treba da se uradi u tekućoj koloni ili u celoj tabli - ali u koji kolonama i koje kolone su sa datumima?
Koliko sam ja razumo poslednij post neparne su sa datumima, a parne sa brojevima koje treba zameniti.

[ Jpeca @ 27.02.2012. 13:48 ] @

Evo kod koji vrsi zamenu vrednosti u tekucoj koloni

Code:
Option Explicit
Sub Zamena()
' Zamenjuje iznose u tekucoj koloni
' Odgovarajucim iznosima za poslednji dan u mesecu
' Datumi moraju biti u prethodnoj koloni
'
' P.Jovanovic za Elitesecurity.org

Dim rwT As Long, rwStart As Long, rwEnd As Long
Dim clT As Long ' tekuca kolona
Dim Mes As Byte
Dim findCl As Range
Dim Rate As Variant

clT = ActiveCell.Column
Mes = 0

rwStart = ActiveCell.End(xlUp).Row
rwEnd = ActiveCell.End(xlDown).Row

For rwT = rwStart To rwEnd
With ActiveSheet
    If Month(.Cells(rwT, clT - 1).Value) <> Mes Then
      Mes = Month(.Cells(rwT, clT - 1).Value)
      Set findCl = Range(.Cells(rwT, clT - 1), .Cells(rwEnd, clT - 1)) _
                    .Find(DateAdd("d", -1, DateSerial(Year(.Cells(rwT, clT - 1).Value), Mes + 1, 1)))
      If findCl Is Nothing Then
         Rate = CVErr(xlErrNA) ' Upisuje gresku #N/A ukoliko nije nadjen
      Else
         Rate = findCl.Offset(0, 1).Value
      End If
    End If
    .Cells(rwT, clT).Value = Rate
End With
Next rwT

End Sub

[ ramzesIV @ 27.02.2012. 14:07 ] @

u jednom sheet-u imam ove podatke. kolona A datumi, B ime ispod kojih su brojevi, pa kolona C datum, kolona D opet drugi naziv koji sadrzi brojeve, itd.. kao sto sam malopre stavila primer. i tu svake nedelje dodajem poslednje datume.

u drugom sheet-u mi je tabela. u A2, A3, A4, ... su ime , B1, C1, D1, nazivi formula koje racunam. neke formule se lako mogu u excelu napisati (samo u jednoj celiji). npr u celiji B2, B3, B4, mi je formula samo vlookup (koji trazi podatke iz prvog sheet-a)

ali za C2, C3, C4 ne moze u jednoj celiji da se napise excel formula. e ja hocu funkciju jer ne mogu ovo sto mi treba da izracunam samo u toj jednoj celiji sa excel formulama. (ili ja ne znam).

jer treba da trazi samo poslednji dan u mesecu, pa da sa vlookup (ili offset) nadje broj tog poslednjeg dana. kao sto sam stavila malopre primer.

to je prvi deo funkcije.

drugi deo: onda se deli nadjeni broj kraja meseca sa prethodnim mesecom.

tako cu imati kao u primeru: =(70( sto je mart)/60 (februar))=16,666
imam onda npr =75 (april)/ 70 (mart) = 1,07.

treci deo: i onda na kraju funkcija treba da trazi najmanji broj. u ovom primeru mi krajnji rezultat bio 1,07

ovo je primer sta funkcija treba da radi samo za jednu kolonu.

onda bih ja sa OFFSET tu funkciju prebacivala za svako ime koje treba da racunam.

nadam se da sam bar malo objasnila.

ja poceh nesto da pisem, verovatno puno gresaka:

Code:

Function MinPerf()
Dim LastDayinMonth as date
Dim mdate as date
Dim LastRow as long
Dim i as Integer
Dim j as integer

for i = 1 To n-1
LastRow= Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set myRange = Range ("A4:A" & LastRow)
J = myRange.Offset(0,1).value

If mDate=0 Then
mDate = Date
End If

LastDayinMonth = DateSerial(Year(mDate), Month(mDate) +1,0)

If i = LastDayinMonth Then
i = j

End If
Next
End Function

[ Jpeca @ 27.02.2012. 14:24 ] @

Ajde ako nije problem postavi primer za taj drugi list sa objašnjenjem - formulama koje sad koristiš i gde je porblem. Ovako mi baš i nije jasno. Iz toga što si navela ispalo bi da treba samo naći vrednosti za kraj meseca, a ne za sve datume iz prvog lista. Ali ne razmem gde zadaješ mesec.

Cifre i nazivi u primeru netreba da budu iz realnog primera ako ti to pravi problem.

[ ramzesIV @ 27.02.2012. 14:45 ] @

ma postavila bih ja na pocetku excel fajl. nego su mi na mom browseru zakljucali ovaj forum, ne mogu ga vise otvoriti, vec su nam uveli neki surfstation, gde mogu samo da otvorim i pisem. a da uploadujem ne mogu. kad dodjem kuci veceras cu uploadovati.

[ ramzesIV @ 27.02.2012. 15:00 ] @

Code:
...
Function myFunc(Area as range, month as integer, year as integer)
Dim d as date, i as long

d= DateSerial(Year, Month+1, -1)
For i = 1 To Area.Rows.Count

if Area.Cells(i,1).Value=d Then
myFunc = (Area.Cells(i, 2).Value / Day(Area.Cells(i,1).Value))-1
Exit Function
End If
Next
End Function

ovako nesto slicno, kad bi moglo.

datum ne pisem nigde, on mi samo sluzi da nadjem poslednji broj u mesecu.

[ ramzesIV @ 27.02.2012. 19:38 ] @

e, evo pojednostavljenog primera kako bi trebalo izgledati.

[ Jpeca @ 28.02.2012. 09:45 ] @

U primeru koji si postavila nema poslednji datum u mesecu za 7-2009. Takva situacija treba nekako da se obradi ali ne znam šta. Uglavnom za zadati opseg
B4:B1648 (bez tog juna na kraju) ova funkcija daje rezultat koji si tražila

Code:
Public Function MinPerf(rngName As Range) As Variant
'
' Nalazi minimalnu relativnu promenu vrednosti
' za poslednji datum u mesecu
' rngName je kolona sa vrednostima
' Odgovarajuci datumi moraju biti u prethodnoj koloni
'
' P.Jovanovic za Elitesecurity.org

Dim rwT As Long, rwEnd As Long
Dim Mes As Byte
Dim findCl As Range
Dim Rate0 As Double, Rate1 As Double
Dim Min As Double, Min1 As Double
Dim strDate As String

If rngName.Columns.Count > 1 Then
   MinPerf = CVErr(xlErrValue) ' Neodgovarajuci broj kolona
   GoTo Kraj
End If

rwEnd = rngName.Rows.Count

' Pocetna vrednost
Mes = Month(rngName.Offset(0, -1).Cells(1, 1).Value)
Set findCl = rngName.Offset(0, -1).Find(EOMonth(rngName.Offset(0, -1).Cells(1, 1).Value), _
   After:=rngName.Offset(0, -1).Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If findCl Is Nothing Then ' Kraj meseca nije pronadjen
         MinPerf = CVErr(xlErrNA)
         GoTo Kraj
End If
Rate0 = findCl.Offset(0, 1).Value
Min = 1000   ' Pocetna vrednost za Min treba da bude dovoljno velika da se ne desi

For rwT = 1 To rwEnd - 1
With rngName
    If Month(.Offset(rwT, -1).Cells(1, 1).Value) <> Mes Then
      Mes = Month(.Offset(rwT, -1).Cells(1, 1).Value)
      strDate = EOMonth(.Offset(rwT, -1).Cells(1, 1).Value)
      Set findCl = .Offset(0, -1) _
                    .Find(strDate, After:=.Offset(rwT, -1).Cells(1, 1), _
                     LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                     SearchDirection:=xlNext, MatchCase:=False)
      If findCl Is Nothing Then ' Kraj meseca nije pronadjen
         MinPerf = CVErr(xlErrNA)
         GoTo Kraj
      End If
      Rate1 = findCl.Offset(0, 1).Cells(1, 1).Value
      Min1 = Rate1 / Rate0 - 1
      If Min > Min1 Then
           Min = Min1
      End If
      Rate0 = Rate1
    End If
End With

Next rwT

MinPerf = Min

Kraj:
End Function

Nedostatak je što se pretraživanje datuma vrši po stringu pa format mora da bude odgovarajući. Funckiju EOMonth sam takodje prepravio da vraća string u odgovarajućem formatu

_{[Ovu poruku je menjao Jpeca dana 01.03.2012. u 09:22 GMT+1]}

[ ramzesIV @ 28.02.2012. 10:45 ] @

javlja mi gresku:

EoMonth Sub or Function not defined.

[ Jpeca @ 28.02.2012. 11:08 ] @

Pogledaj u primeru koji sam postavio. Ako radiš na novom fajlu potrebno je da prekopiraš i EOMonth funkciju u modul.

[ ramzesIV @ 28.02.2012. 13:48 ] @

dakle opet cekanje dok ne dodjem kuci jer ne mogu na ovom kompjuteru nista.

[ ramzesIV @ 29.02.2012. 10:21 ] @

da ne bih ja sama ispravljala i kvarila kod, pitanje:

da li moze da se uvede uslov, recimo do until last EoMonth?

i da ja selektujem celu kolonu (B:B), a da kod pocne od recimo B4.

to sam resila u ovoj funkciji max_drawdown:

Code:

If matrice.Rows.Count=Rows.Count Then
Set matrice= Range(matrice.Cells(4), matrice.Cells(matrice.Cells.Count).End(xlUp))
End If

tako da se u tvom kodu mozda rwEnd ili rngName redefinise?

inace, hvala! napisao si komplikovan kod, trebace mi 2 dana (sa mojim znanjem) da shvatim. :)

[ Jpeca @ 29.02.2012. 16:13 ] @

Prepravio sam kod tako da prihvata celu kolonu kao argument. Obrati pažnju da bez obzira koji opseg se izabere uzeće se cela kolona na početku.
Onda se od te kolone pravi opseg od četvrtog reda (parametar rwStart) do poslednjeg kranjeg datuma u mesecu. U opsegu nesmeju biti prazne ćelije.

Code:
rwEnd = rngName.Cells(rwStart, 1).End(xlDown).Row
For rwT = rwEnd To rwStart Step -1  'Pronalazi poslednji kraj meseca
  If rngName.Offset(ColumnOffset:=-1).Cells(rwT, 1).Text = _
       EOMonth(rngName.Offset(ColumnOffset:=-1).Cells(rwT, 1).Value) _
  Then
     Exit For
  End If
Next rwT
rwEnd = rwT
'Nove dimenzije opsega
Set rngName = rngName.Columns.Resize(rwEnd - rwStart + 1).Offset(rwStart - 1)

Dalje se ovaj opseg koristi kao i ranije.

_{[Ovu poruku je menjao Jpeca dana 01.03.2012. u 09:49 GMT+1]}

_{[Edit: Line break]}

_{[Ovu poruku je menjao 3okc dana 08.03.2012. u 19:35 GMT+1]}

[ ramzesIV @ 07.03.2012. 21:21 ] @

sorry, sto ne stigoh pre, samo da se zahvalim na kodu.

ovo je jedna statisticka funkcija i vecina banaka je izracunava, tako da ce mnogima koji su u tim vodama pomoci.

hvala jos jednom!