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

  • 19 odgovora
  • 5.098 pregleda
Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 11:24 · pre 178 meseci #1
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, ...

Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 12:13 · pre 178 meseci #2
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:

Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 12:29 · pre 178 meseci #4
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"

Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 12:52 · pre 178 meseci #5
Ako koristiš tabelu dovanjem novih redova na dno tabele, formula u trećoj koloni se automatski dodaje tako da tu ne vidim problem.
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 13:08 · pre 178 meseci #7
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.
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 13:48 · pre 178 meseci #8
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
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 14:07 · pre 178 meseci #9
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
 
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 14:24 · pre 178 meseci #10
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.
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 14:45 · pre 178 meseci #11
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.

Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 27.02.2012. u 15:00 · pre 178 meseci #12
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.

Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 28.02.2012. u 09:45 · pre 178 meseci #14
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]
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 29.02.2012. u 10:21 · pre 178 meseci #18
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. :)
Re: Korisnička funkcija koja traži vrednosti za poslednji dan u mesecu 29.02.2012. u 16:13 · pre 178 meseci #19
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]
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Prijavite se da biste odgovorili u ovoj temi.PrijavaRegistracija

Premeštanje teme