07. marts 2007 - 20:28
Der er
7 kommentarer og
1 løsning
Oplistning af forekomster
Jeg har et dieselregnskab, hvor jeg har en "form" indtaster selskab i tbSelskab og sted i tbSted.
tbSelskab indsættes i Ark1 kolonne C i den første række, der er tom. tbSted sættes i Ark1 kolonne D i samme række.
I Ark 2 i kolonne Y, Celle 1 har jeg Selskab 1 i de efterfølgende rækker står alle stederne fra Ark1 kolonne D.
Det jeg har brug for er en makro, der sætter teksten i tbSted ind i Ark2 kolonne Y i den første tomme række hvis tbSted er den samme som det selskab der står i Ark2 Y1. og samtidig sætter formlen =TÆL.HVIS(Kilometerregnskab!C6:D12;Y4) ind i samme række i kolonne Z. D12 ændre sig efterhånden som jeg tanker bilen.
18. marts 2007 - 12:29
#6
Har du modtaget min mail? - hvis ikke så er koden her - indlagt i slutningen af Userformen.
...
...
...
'Pris pr. liter ved tankning
ActiveCell.Offset(0, 10).Value = tbLiterpris.Value * 1
'Valuta
ActiveCell.Offset(0, 11).Value = tbValuta.Text
End If
rem HERFRA+++++++++++++++++++++++
Rem Opdatering af tankning
opdateriBeregninger
End Sub
Sub opdateriBeregninger()
Dim antalRækKM
Rem find antal rækker på ark Kilometerregnskab - start i B6
For r = 6 To 65000
If Cells(r, 2) = "" Then
antalRækKM = r
Exit For
End If
Next r
Rem find kolonnen i række 1 Kolonne Y - AI
ActiveWorkbook.Sheets("Beregninger").Activate
startkol = Range("Y1").Column
slutkol = Range("AI1").Column
For kol = startkol To slutkol
If Me.tbSelskab = Cells(1, kol) Then
Cells(3, kol).Select
For r = 3 To ActiveCell.SpecialCells(xlLastCell).Row
If Cells(r, kol) = "" Then
Cells(r, kol).Select
ActiveCell.Value = Me.tbSted
Cells(r, kol + 1) = beregnAntal(antalRækKM, Me.tbSelskab, Me.tbSted)
Exit Sub
Else
If Cells(r, kol) = Me.tbSted Then
Cells(r, kol + 1) = beregnAntal(antalRækKM, Me.tbSelskab, Me.tbSted)
Exit Sub
End If
End If
Next r
End If
Next kol
End Sub
Private Function beregnAntal(rækKM, selsk, sted)
Dim antal
antal = 0
For r = 6 To rækKM
With ActiveWorkbook.Sheets("Kilometerregnskab")
If .Cells(r, 3) = selsk And .Cells(r, 4) = sted Then
antal = antal + 1
End If
End With
Next r
beregnAntal = antal
End Function
