Excel-makro som summerer vilkårlig antall ranges og/eller enkeltceller.

[ATWindsor]

Hei, jeg er veldig lite erfaren i VBA-programmering, så dette er kanskje et nybegynnerspørsmål der jeg trenger mye hjelp. Jeg skal lage en funksjon som logaritmisk summerer en rekke tall, selve matematikken er lekende lett, alt man trenger å gjøre er å regne sammen dette LOG(10^tall1+10^tall2......). Så denne delen av funksjonen er ikke noe problem. Porblemet er at jeg vil ha den til å ta input på samme måte som SUM-funksjonen i excel. Dvs et vilkårling antall, og en vilkårling blanding av ranges, celler og absolutte verdier. Mao jeg vil kunne skrive LOGSUM(A1:A3,D7:D13,F3,4) feks. (om absolutte talle ikke er lett å få til, i det minste et vilåkårlig antalle ranges/celler).

 

jeg har forstått det som ParamArray kan være behjelpelig om man har et sette enkeltverdier, men ikke om manhar et sett med vilkårlig antall ranges inneblandet, så jeg håper noen har mulighet til å hjelpe meg. På forhånd takk for all hjelp

 

AtW

Endret 20. februar 2008 av ATWindsor

[Harald Staff]

Se om dette får deg i gang:

 

Public Function myFunction(ParamArray vals() As Variant) As String

Dim L As Long

For L = LBound(vals) To UBound(vals)

myFunction = myFunction & TypeName(vals(L)) & ", "

Next

End Function

 

Sub Test()

Dim S As String

S = myFunction(Range("A1:C5"), 45, 12.5, "Harald")

MsgBox S

End Sub

 

eller direkte i regnearket:

=myFunction(E7:E10;F7:F10;12;"Jada")

 

HTH. Beste hilsen Harald

[ATWindsor]

Tusen takk for hjelpen Harald! Du har vært veldig hjelpsom så langt. Beklager det sene svaret, men jeg fikk ikke tid til å se på dette før i dag tidlig. Jeg har nå forsøkt å implmentere en variant med utregning av det jeg trenger. Men jeg sliter fortsatt litt, alt går fint om det er en enkelt-celle eller tall som er input, men jeg får det fortsatt ikke til med en range her er min modifiserte kode.

 

Public Function myFunction(ParamArray vals() As Variant) As Double

Dim L As Long

For L = LBound(vals) To UBound(vals)

If TypeName(vals(L)) = "Range" Then

MsgBox "Oh No!"

'Må implmentere egen utregning for range?

Else

myFunction = myFunction + 10 ^ (vals(L) / 10)

End If

Next

myFunction = 10 * Application.WorksheetFunction.Log(myFunction)

End Function

 

Sub Test()

Dim S As String

S = myFunction(Range("A1:A2"), 10, "10", 12.5)

MsgBox S

End Sub

 

Som du ser har jeg endret det til å regne på tallene som kommer inn, og lagt til en if-then funksjon som sjekker om det som kommer inn er en range. For øyeblikket er det eneste som skjer om det kommer inn en range at den lager en boks som sier "oh no", istedet må jeg få implmentert en egen utregning for range. Jeg prøvde å lage denne utregningen for range, men det nærmeste jeg fikk til var dette:

 

Sub LogArray()

Dim Celle As Range

Dim W As Double

For Each Celle In Selection

If Celle.Value > 0 Then W = W + (10 ^ (Celle.Value / 10))

Next Celle

W = 10 * Application.WorksheetFunction.Log(W)

MsgBox W

End Sub

 

Denne tar en range og regner sammen på riktig måte. Problemet er at jeg ikke kan nok til å få til dette med en "input-range" jeg får det bare til om jeg bruker "Selection". Mao sliter jeg med å finne ut hva slags syntax jeg skal bruke for å gjøre dette med en input-range istedetfor bare med "Selection". Håper problemet mitt var noenlunde forståelig. Jeg er helt ny på dette, så jeg er nok ikke så flink til å forklare meg.

 

AtW

[Harald Staff]

Du er veldig nær, godt jobba.

Prøv dette:

 

Dim Cel As Range

 

For L = LBound(vals) To UBound(vals)

If TypeName(vals(L)) = "Range" Then

For Each Cel In vals(L)

myFunction = myFunction + 10 ^ (Cel.Value / 10) 'eller hva nå regnestykket var

Next

Else

 

Pass også på at du tar høyde for tekstverdier (string) som input eller celleverdier, ellers kan du få feil.

 

HTH. Beste hilsen Harald

[ATWindsor]

Doh! Den løsningen var jo pinlig enkel Tusen takk for hjelpa nok en gang. Det ferdig produktet har blitt noe sånt som dette:

 

Public Function myFunction(ParamArray vals() As Variant) As Double

Dim L As Long

Dim Cel As Range

Dim T As Variant

For L = LBound(vals) To UBound(vals)

If TypeName(vals(L)) = "Range" Then

For Each Cel In vals(L)

'Sjekker om cellen er tom eller har en formel som har returnert "", om så er tilfelle taes ikke cellen med i utregningen

If Cel.Value <> "" Then

'Sjekker om cellen kan gjenkjennes som tall, om ikke tas ikke cellen med

If IsNumeric(Cel.Value) Then myFunction = myFunction + 10 ^ (Cel.Value / 10)

End If

Next

 

Else

myFunction = myFunction + 10 ^ (vals(L) / 10)

End If

Next

'Sørger for at det blir returnert null om tallet det taes logaritmen av er mindre enn 1

If myFunction < 1 Then myFunction = 1

myFunction = 10 * Application.WorksheetFunction.Log(myFunction)

End Function

 

Jeg har et ørlite spørsmål til: Jeg tar en sjekk om cellen er tom (dvs om den innholder "") da jeg ikke vil ta med tomme celler, eller celler der formerl har returnert "", jeg hadde håpt denne sjekken skulle effektivisere kjøringen av funksjonen litt. Men det er fortsatt slik at det tar ganske lang tid å kjøre om man tar inn en range med endel titusner celler i. Er det noen grei måte å raskere utelukke de tomme cellene, så store mengder store celler ikek drar ned hastigheten på funksjonen så mye? (dvs de drar jo ikke ned hastigheten mer enn celler med innhold da)

 

AtW

[Harald Staff]

Bra jobba. Men du må håndtere tekst der input ikke er range også:

 

Else

If IsNumeric(Cel.Value) Then myFunction = myFunction + 10 ^ (vals(L) / 10)

End If

 

Jeg antar du bare passer de relevante cellene, ikke hele kolonner og sånt ? Du kan utelukke alt annet enn ikke-tomme tallceller slik:

 

Dim FilledCells As Range

'---

For L = LBound(vals) To UBound(vals)

If TypeName(vals(L)) = "Range" Then

Set FilledCells = Union(vals(L).SpecialCells(xlCellTypeConstants, 1), vals(L).SpecialCells(xlCellTypeFormulas, 1))

For Each Cel In FilledCells

'---

 

Men du må nok regne med at det tar litt tid uansett. VBA er fra naturens side MYE tregere enn C++, og Excel er mesterlig programmert når det gjelder hastighet, så man blir godt vant.

 

EDIT det går selvfølgelig ikke så godt når hodet er mer fokusert på fredagspils enn på kode. Vi har jo ekskludert alt som ikke er tall, så du kan droppe et par tidkrevende sjekker også:

 

For Each Cel In FilledCells

myFunction = myFunction + 10 ^ (Cel.Value / 10)

Next

 

Takk til alle som har usikret trådløst nettverk og som bor rett ved siden av en pub, det er meg til stor glede

 

HTH. Beste hilsen Harald

Endret 22. februar 2008 av Harald Staff

[Harald Staff]

To komplikasjoner her. Først krever jeg nok litt mye av deg når det gjelder implementering, den feiler hvis det ikke er tallceller i et område. Du må ha feilhåndtering og resette FilledCells etter hver range. Komplett løsning:

 

Public Function myFunction(ParamArray vals() As Variant) As Double

Dim L As Long

Dim Cel As Range

Dim T As Variant

Dim FilledCells As Range

 

For L = LBound(vals) To UBound(vals)

If TypeName(vals(L)) = "Range" Then

On Error Resume Next

Set FilledCells = Union(vals(L).SpecialCells(xlCellTypeConstants, 1), vals(L).SpecialCells(xlCellTypeFormulas, 1))

On Error GoTo 0

' Debug.Print FilledCells.Address

If Not FilledCells Is Nothing Then

For Each Cel In FilledCells

If IsNumeric(Cel.Value) Then myFunction = myFunction + 10 ^ (Cel.Value / 10)

Next

End If

Set FilledCells = Nothing

Else

If IsNumeric(vals(L)) Then myFunction = myFunction + 10 ^ (vals(L) / 10)

End If

Next

If myFunction < 1 Then myFunction = 1

myFunction = 10 * Application.WorksheetFunction.Log(myFunction)

End Function

 

Og så skjer det utrolig merkelige (i min Excel2003) at UNION virker lynraskt og perfekt når jeg kaller den i VBA:

 

Sub test()

MsgBox myFunction(Sheets(1).Range("A1:BA10000"))

End Sub

 

mens den feiler og looper hele områdene når jeg bruker den i regnesarkcelle:

=myfunction(A1:BA10000)

derfor går denne tregt, og derfor må den ha IsNumeric-testen i seg. Skal se om jeg finner en forklaring på dette, men seeing is believing.

 

HTH. Beste hilsen Harald

[ATWindsor]

Takk igjen for tips. Grunnen til at jeg ikke sjekker at det er numeric på tall mans etter inn manuelt er at jeg antok at om man skriver noe feil her, så vil man gjerne vite det, istedet for at verdien som er feil blir "ignorert", ingen vil med viten og vilje prøve å skrive inn noe annet enn et tall, så om de gjør det på feil måte er det greit om de får tilbake en error. Det er ihvertfall tanken bak, men det er kanskje ikek så bra programeringspraksis?

 

Når det gjelder ditt forslag, så opplever jeg det samme som deg, så i "vanlig bruk" så er desverre ikke den metoden noe raskere enn slik jeg orginalt har gjort det (om noe, så er den noe tregere). Og som du kanskje vet, så blir å legge sammen mange logaritmiske verdier på 0 et tall som er (til dels vesentlig) større enn null. Ditt forslag tar med tomme celler som verdien 0, og derfor får man feil om man legger sammen en range som innholder tomme celler. Men metodene du skisserer i forslaget ditt virker veldig nytttig å kunne.

 

AtW

[Harald Staff]

Skjønner problemet. Du må ha med en

If X > 0 Then

eller en

If X <> 0 Then

-aktig sjekk også da.

 

Ellers er Datavalidering et godt sted å kontrollere innskrevne data, eventuelt Worksheet_Change-eventet til regnearket. Alt ettersom hva det brukes til og av hvem. Men heller der enn direkte i beregningene, som logisk sett ligger senere og ikke skal la seg hefte av ugyldig input. Nå er vi mer inne på stil og trosretninger...

 

Beste hilsen Harald

Endret 25. februar 2008 av Harald Staff

[Harald Staff]

Da er mysteriet oppklart, det var som jeg fryktet.

 

En regnearkformel kan bare en eneste ting; å returnere en verdi til cellen den bor. En formel kan altså aldri endre regneark- eller pc-miljøet.

 

Kode kan kalle hendelser, som å endre celleområder, slette rader, slette filer, ... og funksjoner kan dette medmindre de kalles fra regnearkceller, da unerlegges de samme begrensninger som innebygde formler. Og av en eller annen pussig grunn er også SpecielCells definert som en hendelse.

 

Beste hilsen Harald