VBA Excel kode virker hver 2 gang

Jeg skal ikke gøre mig klog på Excel programmering, arbejder mest med Access, men jeg undrer mig over, at du har defeneret det som en funktion, når den øjensynligt ikke returnerer en værdi. Var det ikke bedre at ændre det til en subrutine i så fald?

Jeg er ikke selv en haj til VBA, så jeg bliver nødt til at spørge hvad forskel det gør?

Hvis counter aldrig når værdien af postcounter, rammer du bunden af arket. Det vil give den omtalte fejl.
Og hvad er værdien postcounter? Det er ikke defineret i din function!

Tak for svar, akyhne. Du har ret i det du pointere, men hvad skulle forhindre koden i at lykkedes hver anden gang.

Hvis jeg i øvrigt ændrer IF betingelsen fra Activecell.Value til Activecell.Text (hvilket i mit tilfælde ville forbedre funktionens stabilitet), får jeg fejlen hver gang - altså koden lykkedes slet ikke. Hva de to elementer har med hinanden at gøre - det må guderne vide.

postcounter er en global variabel. Ligeledes er der meget mere kode end det viste. Tænkte at jeg i første omgang kun ville poste den kode samt det tilhørende der fejlede.

Postcounter stammer fra en anden sub, der tjekker hvor mange poster der skal behandles.

ReDim postvalue(postcounter): Hvad er denne, når koden fejler? Hvis den er større end nederste celles rækkenr., vil koden jo nå enden og fejle.

Hvorfor sætter du i øvrigt ikke Application.ScreenUpdating til true i enden?

Desuden vil koden køre til bunden, hvis ikke der er 2-taller nok.

Du kunne nøjes med at søge til nederste celle der er skrevet i. Bunden kan du finde med denne kode:

Sub test()
Application.Goto reference:="Konto"
S = ActiveCell.Row
Slut = ActiveCell.Offset(65536 - S).End(xlUp).Row
MsgBox Slut
End Sub

Du kunne lave selve søgningen således:

ReDim postvalue(0)
Application.Goto reference:="Konto"
S = ActiveCell.Row
T = ActiveCell.Column
Slut = ActiveCell.Offset(65536 - S).End(xlUp).Row

MitArray = Range(Cells(S + 1, T), Cells(Slut + 14, T))
For I = 1 To UBound(MitArray)
    If MitArray(I, 1) = "2" Then
        counter = counter + 1
        ReDim postvalue(counter)
        postvalue(counter) = MitArray(I + 14, 1)
    End If
Next

Det går langt hurtigere.

Læg mærke til placeringen af ReDim postvalue(counter). Hvis du ikke med sikkerhed har redimmet til en værdi der kan indeholde antallet af 2-taller fundet, vil du også få en fejl.

Det var lidt nemmere, hvis du smed hele koden, eller forklarede lidt om hvad det er der skal ske.

Nå, en lille fejl:

ReDim postvalue(0)
Application.Goto reference:="Konto"
S = ActiveCell.Row
T = ActiveCell.Column
Slut = ActiveCell.Offset(65536 - S).End(xlUp).Row

MitArray = Range(Cells(S + 1, T), Cells(Slut + 14, T))
For I = 1 To UBound(MitArray)
    If MitArray(I, 1) = "2" Then
        counter = counter + 1
        ReDim Preserve postvalue(counter)
        postvalue(counter) = MitArray(I + 14, 1)
    End If
Next

Har absolut ingen anelse om hvad der foregår. Men ved et lille eksperiment ifm. noget andet, delte jeg koden op. Nu virker funktionen som tiltænkt, hver gang.

Application.ScreenUpdating er defineret med True i bunden. Den nederste del af koden er blot ikke skrevet med her, så derfor kan du ikke se det.

Tak for forslaget. Prøver det lige en gang :)

Har lidt problemer med at få tilpasset dit forslag til mit behov. Men ideen er følgende:

Jeg har et regneark med et antal kolonneoverskrifter (deriblandt "Navn", "Konto" og "Beløb") og et antal rækker med tilhørende data.

Nogenlunde sådan her:

|Navn| .... |Konto| .... |Beløb|
--------------------------------
X-navn ....... 0 ....... 100 kr.
Y-navn ....... 2 ....... 200 kr.

Og så fremdeles ..

Meningen er så, at samle alle de poster på konto "2" op i en array variabel, med deres respektive navn og beløb. Disse data skal siden indsættes i et andet ark.

Antallet af rækker kan variere og ligesådan kan antallet af kolonner. Så derfor blir det nødt til at være et array.

Hvorfor skal du springe 14 ned, og hente værdien der?

Du er nok nødt til at vise her hvordan dataene ligger. Evt sende et prøveark til gt4(snabel)racingcar(punkt)dk.

Hvis du har et ark med definerede navneområder "Navn" i A1, "Konto" i B1 og "Beløb" i C1 med tilhørende værdier nedenunder, og gerne vil finde bestemte kontoværdier, kan du bruge noget lignende denne:

Sub test()
FindKonto = InputBox("Skriv kontonummeret du søger:", "Skriv kontonavn")
ReDim postvalue(0)
Application.Goto reference:="Konto"
S = ActiveCell.Row
T = ActiveCell.Column
Slut = ActiveCell.Offset(65536 - S).End(xlUp).Row

MitArray = Range(Cells(S + 1, T - 1), Cells(Slut + 14, T + 1))
For I = 1 To UBound(MitArray)
    If MitArray(I, 2) = "2" Then
        counter = counter + 1
        ReDim Preserve postvalue(counter)
        postvalue(counter) = MitArray(I, 1) & "|" & MitArray(I, 1 + 1) & "|" & MitArray(I, 1 + 2)
    End If
Next

Sheets("Ark2").Select

For I = 1 To UBound(postvalue)
    Navn = Split(postvalue(I), "|")
    Range("A" & I).Value = Navn(0)
    Range("B" & I).Value = Navn(1)
    Range("C" & I).Value = Navn(2)
Next
End Sub

Ok takker. Kigger lige på hvad jeg kan sende til dig. I mellemtiden ser jeg også lige på dit kodeforslag, om jeg kan konvertere det til mit formål.

linien "postvalue(counter) = MitArray(I,1) & ........ fejler med beskeden:

Run-time error '13':
Type mismatch.

Jeg har sendt et prøveeksemplar til den emailadresse du skrev.

Den kode jeg angav 10/08-2007 19:36:58 gør præcis det du forespørger.

Den første grund til din og min kode fejler for dig er denne linie:

Dim postvalue() As Currency

Skal blot være: Dim postvalue()

Anden grund er nok enstavesmutter for dig; Du bruger variablen counterposts og CountPosts for at skulle være den samme.

Super. Tak. Kigger lige på det snarest.

Jeg har sendt arket til dig. Til andre der gerne vil vide hvad jeg har lavet:
nicolaus har brugt koden fra 10/08-2007 19:36:58 sammen med en form der lister værdierne. Derfor poster jeg ikke mere kode her for andres skyld. Eneste ændring er at der lige skal dimmes en værdi, øverst i koden: Dim counter as long.

Har du kigget på det?

akyhne:
Nej, ikke endnu. Tiden er fløjet afsted, den seneste tid. Men kigger snarest på det.

Ok, jeg holder dig op på det ;-)

Det i orden :)

I øvrigt har jeg ikke modtaget arket ..

Så har jeg testet koden og det fungerer præcis som ønsket :) Tak for hjælpen.
Hvis du smider svar, så smider jeg point.

Det kommer her.

Takker for point.