Seuraavanlainen ongelma: kahdessa sarakkeessa on tietoja joista pitäisi saada laskettua yhteen ne, jotka ovat suoraan alekkain eli joiden välissä ei ole tyhjiä soluja. Muuten tyhjiä soluja on riveillä epäsäännöllisesti. Tämä yhteenlasku pitäisi saada tehtyä automaattisesti. Millainen VB koodi ratkaisisi tämän ongelman?
Yhteenlasku automaattisesti
JaJar
6488
0Äänestä
Muut lukivat myös
Odottaa vastausta
Näihin keskusteluihin ei ole vielä vastattu. Ole ensimmäinen.
Vastaukset 6
Vanhimmat
niin sinulla on lukuja kahdessa sarakkeessa, kyseisillä sarakkeilla ei laskennan kannalta ole mitään yhteistä ja jotka eivät ole välttämättä vierekkäin. Näistä molemmista sarakkeista haluat laskea peräkkäisten lukujen summat.
Ohessa koodi joka olettaa että luvut eivät ole vierekkäisissä sarakkeissa (koodissa lukusarakkeen viereinen sarake käytetään laskentakaavoihin) ja laskenta aloitetaan valitusta solusta:
-----------------------------
Sub Laskeyhteen()
ActiveCell.Offset(0, 1).Select
Dim Kaavasarake As String
Kaavasarake = Left(ActiveCell.Address, 2)
MsgBox "Nollataan kaavasarake " & Kaavasarake
Range(Kaavasarake & "1:" & Kaavasarake & "10000").Select
Selection.ClearContents
ActiveCell.Offset(0, -1).Select
For S = 1 To 100
Dim LähtöLuku As String
Dim LähtöRivi As String
Dim LähtöSarake As String
LähtöLuku = ActiveCell.Value
LähtöRivi = ActiveCell.Row
LähtöSarake = Left(ActiveCell.Address, 2)
If LähtöLuku = "" Then
ActiveCell.Offset(1, 0).Select
GoTo Loppu
End If
Seuraava:
ActiveCell.Offset(1, 0).Select
Dim SeuraavaLuku As String
Dim SeuraavaRivi As String
SeuraavaLuku = ActiveCell.Value
SeuraavaRivi = ActiveCell.Row
If SeuraavaLuku = "" Then
ActiveCell.Offset(-1, 1).Select
ActiveCell.Formula = "=SUM(" & LähtöSarake & LähtöRivi & ":" & LähtöSarake & SeuraavaRivi & ")"
ActiveCell.Offset(1, -1).Select
ActiveCell.Offset(1, 0).Select
GoTo Loppu
Else
GoTo Seuraava
End If
Loppu:
Next S
Range(LähtöSarake & "1").Select
MsgBox "Peräkkäisten lukujen summat laskettu sarakkeeseen " & Kaavasarake
End Sub
...täytyy kokeilla tuota.
Laskee yksittäisen sarakkeen summan esim. C-sarake
-tulos näytetään msgboxissa. Jos haluat näyttää sen jossakin solussa niin muuta
msgbox summa---> esim. Range("G1")=summa
next c jälkeen voit lisätä toisen sarakkeen tarvittaessa esim D-sarake
vika = Range("D65536").End(xlUp).Row
summa = summa Val(Range("D1"))
For Each c In Range("D1:D" & vika)
If Not c.Offset(1, 0) = "" Then
summa = summa Val(c.Offset(1, 0))
Else
End If
Next c
Sub summa()
Dim vika As Integer
Dim summa As Double
vika = Range("C65536").End(xlUp).Row
summa = Range("C1")
For Each c In Range("C1:C" & vika)
If Not c.Offset(1, 0) = "" Then
summa = summa Val(c.Offset(1, 0))
Else
End If
Next c
'tähän lisäkoodi
MsgBox summa
End Sub
Kokeilin tuota antamaasi koodia ja toimi mainiosti mutta millä sen saisi tekemään niin että kaavan tulos tulisi kahdesta alekkain olevasta luvusta ylemmän kanssa samalle riville? Sain sen kyllä tekemään näin mutta sitten kaikki ne luvut joita on vain yksi, tulostuvat riviä liian ylös. Minulla on nimittäin A-sarakkeessa luku (as.nro.) ja C-sarakkeessa nämä luvut jotka pitäisi saada laskettua yhteen. Toisaalta saman asian ajaisi sellainenkin makro joka tarkistaisi onko kahdella rivillä perättäisiä lukuja ja jos on niin kopioisi ylemmän luvun kohdalta as.numeron myös alemman luvun kohdalle....
niin että ennen kaavan kirjoitusta ohjelma menee kaavasarakkeeseen lähtöriville, kirjoittaa kaavan ja palaa soluun jossa oli ennen kaavan kirjoittamista eli näin:
---------------------------------
If SeuraavaLuku = "" Then
Dim PaluuRivi As String
PaluuRivi = ActiveCell.Row
Range(Kaavasarake & LähtöRivi & "").Select
'ActiveCell.Offset(-1, 1).Select
ActiveCell.Formula = "=SUM(" & LähtöSarake & LähtöRivi & ":" & LähtöSarake & SeuraavaRivi & ")"
'ActiveCell.Offset(1, -1).Select
Range(LähtöSarake & PaluuRivi & "").Select
ActiveCell.Offset(1, 0).Select
GoTo Loppu
Else
GoTo Seuraava
End If
Kiitos paljon! Nyt toimii juuri niinkuin pitää.