Taulukon A sarakkeessa tuotteiden nimiä, jotka esiintyvät taulukossa useampaan kertaan, Nimiä on useita satoja erilaisia, ja kukin esiintyy siis useamman kerran. Taulukon D sarakkeessa on kunkin tuotteen nimen kohdalla luku (tilausmäärä) joka on välillä 0-1000. Nyt pitäisi saada kunkin tuotteen nimen yhteenlaskettu määrä laskettua, olipa tuotteiden nimet missä kohdin tahansa taulukon A saraketta, a tehtyä erillinen lista jossa on tuotteiden nimet toisessa sarakkeessa ja yhteenlaskettu määrä kullekin tuotteelle toisessa.
Eli jos vaikkapa taulukon riveillä 8, 27, 55, ja 77 lukee A sarakkeessa tuote1 ja kunkin kohdalla D sarakkeessa on eri tai sama luku, ne pitäisi saada laskettua yhteen ja tehtyä niistä 1 rivi erilliseen taulukkoon jossa tuotteen nimi on toisessa sarakkeessa ja yhteenlaskettumäärä toisessa.
Ettei olisi liian helppoa, eri tuotteiden lukumäärä ei ole vakio.
Eli jos vaikkapa taulukon riveillä 8, 27, 55, ja 77 lukee A sarakkeessa tuote1 ja kunkin kohdalla D sarakkeessa on eri tai sama luku, ne pitäisi saada laskettua yhteen ja tehtyä niistä 1 rivi erilliseen taulukkoon jossa tuotteen nimi on toisessa sarakkeessa ja yhteenlaskettumäärä toisessa.
Ettei olisi liian helppoa, eri tuotteiden lukumäärä ei ole vakio.
Vastaukset 22
Vanhimmat
moduuliin...
Option Explicit
Sub SummaaTuotteeet()
Dim Vika As Integer
Dim Solu As Range
Dim EiTuplat As New Collection
Dim i As Integer
Dim j As Integer
Dim Löydetty As Double
On Error Resume Next
Worksheets("Sheet2").Activate
Range("A:B") = ""
Range("A1") = "Tuote"
Range("B1") = "Summa"
Worksheets("Sheet1").Activate
Vika = Range("A65536").End(xlUp).Row
For Each Solu In Range("A1:A" & Vika)
EiTuplat.Add Solu.Value, CStr(Solu.Value)
Next Solu
On Error GoTo 0
For i = 1 To EiTuplat.Count
Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0) = EiTuplat(i)
Next
Vika = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
For Each Solu In Worksheets("Sheet2").Range("A2:A" & Vika)
Solu.Offset(0, 1) = HaeArvot(Solu, Worksheets("Sheet1").Range("A:A"))
Next Solu
End Sub
Function HaeArvot(Hakuehto As Variant, HakuAlue As Range) As Double
Dim Solu As Range
Dim Ekaosoite As String
With HakuAlue
Set Solu = .Find(What:=Hakuehto)
If Not Solu Is Nothing Then
Ekaosoite = Solu.Address
Do
HaeArvot = HaeArvot Solu.Offset(0, 3).Value
Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address Ekaosoite
End If
End With
End Function
Keep EXCELing
@Kunde
Moi. Vein tuon moduuliin. Sain viestin "subscript out of range" ja kaikki tiedot taulukosta hävisivät ???? Tarkoitus olisi että jos taulukko on välilehdellä 1, välilehdelle 2 tulisi kooste jossa näkyisi kunkin tuotteen nimi kerran ja tuotteen nimen kohdalla eri sarakkeessa yhteismäärä haettuna koko taulukon 1 välilehden niiltä kohdin joissa tuotenimen kohdalla on sarakkeessa D jokin luku. Alkuperäiset tiedot eivät saisi silti hävitä.
Vaihdoitko taulukoiden nimet Sheet1 ja Sheet2 oikeiksi?
Vaihdoin kyllä, tosin viestisi jälkeen. Nyt teki välilehdelle 2 otsikot ; a;sarakkeeseen "tuote" ja b sarakkeeseen "summa". Silti ei tuonut tuotteiden nimiä a sarakkeeseen, eikä kokonaismäärää b sarakkeeseen. Alkutilanne siis se että A sarakkeessa on tuotteiden koodit (numeroita, väliviivoja jne) jotka esiintyvät taulukosssa useilla eri riveillä. D sarakkeessa on tilausmäärä, joka siis tulisi laskea yhteen aina kun A sarakkeessa oleva tuotekoodi on sama. Näitä tuotekoodeja on tosi paljon ja ne pitäisi saada listattua välilehdelle 2 (sheet2) alekkain sarakkeeseen A ja B sarakkeeseen kunkin tuotekoodin kohdalle yhteenlaskettu määrä koko taulukosta (siis sheet1 välilehdeltä)
Hei. Nyt alkoi toimimaan, en tiedä mitä tein, huh , huh. Onkohan tuohon vielä liitettävissä sellainen optio että toisi "sheet1" n C sarakkeesta yksikköhinnan kullekin tuotteelle. Kullakin tuotekoodilla on eri hinta mutta yksittäisillä koodeilla on kuitenkin aina sama hinta. Kiitos kaikesta avusta tähän asti :)
Option Explicit
Sub SummaaTuotteeet()
Dim Vika As Integer
Dim Solu As Range
Dim EiTuplat As New Collection
Dim i As Integer
Dim j As Integer
Dim Löydetty As Double
On Error Resume Next
Worksheets("Sheet2").Activate
Range("A:C") = ""
Range("A1") = "Tuote"
Range("B1") = "Yksikköhinta"
Range("C1") = "Summa"
Worksheets("Sheet1").Activate
Vika = Range("A65536").End(xlUp).Row
For Each Solu In Range("A1:A" & Vika)
EiTuplat.Add Solu.Value, CStr(Solu.Value)
Next Solu
On Error GoTo 0
For i = 1 To EiTuplat.Count
Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0) = EiTuplat(i)
Next
Vika = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
For Each Solu In Worksheets("Sheet2").Range("A2:A" & Vika)
Solu.Offset(0, 1) = HaeArvot2(Solu, Worksheets("Sheet1").Range("A:A"))
Solu.Offset(0, 2) = HaeArvot(Solu, Worksheets("Sheet1").Range("A:A"))
Next Solu
Worksheets("Sheet2").Columns("A:C").AutoFit
End Sub
Function HaeArvot(Hakuehto As Variant, HakuAlue As Range) As Double
Dim Solu As Range
Dim Ekaosoite As String
With HakuAlue
Set Solu = .Find(What:=Hakuehto)
If Not Solu Is Nothing Then
Ekaosoite = Solu.Address
Do
HaeArvot = HaeArvot Solu.Offset(0, 3).Value
Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address Ekaosoite
End If
End With
End Function
Function HaeArvot2(Hakuehto As Variant, HakuAlue As Range) As Range
Dim Solu As Range
Dim Ekaosoite As String
With HakuAlue
Set Solu = .Find(What:=Hakuehto)
If Not Solu Is Nothing Then
Ekaosoite = Solu.Address
Do
Set HaeArvot2 = Solu.Offset(0, 2)
Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address Ekaosoite
End If
End With
End Function
Keep EXCELing
@Kunde
Kiitos Kunde. Jos vain kerkiät niin voisitko kertoa minulle mikä osio tuossa makrossa (onko oikea nimitys sille ?) hakee tiedon mistäkin ? Aivan vain mielenkiinnosta jos joskus oppisi tuota vba:ta käyttämään. Kiitos paljon tähän astisesta avusta.
Option Explicit
Sub SummaaTuotteeet()
Dim Vika As Integer
Dim Solu As Range
Dim EiTuplat As New Collection
Dim i As Integer
Dim j As Integer
Dim Löydetty As Double
On Error Resume Next
'aktivoidaan Sheet2
Worksheets("Sheet2").Activate
'tyhjennetään sarakkeet A-C
Range("A:C") = ""
'lisätään Tuote teksti A1
Range("A1") = "Tuote"
'lisätään Yksikkätuote teksti B1
Range("B1") = "Yksikköhinta"
'lisätään Summa teksti B1
Range("C1") = "Summa"
''aktivoidaan Sheet1
Worksheets("Sheet1").Activate
'haetaan A-sarakkeen käytössäoleva vika rivi
Vika = Range("A65536").End(xlUp).Row
'luupataan alue A sarakkeen alue läpi ja lisätään kokoelmaan
'koska alussa oli On Error resume Next, niin ohjelma jatkaa toimintaasta , vaikka virhe tulisikin...
' ja virheitä tuleekin, koska kokoelmaan ei voi lisätä tupla arvoja ja tämä virhetarkastelua käytin tässä apuna ;-)
For Each Solu In Range("A1:A" & Vika)
EiTuplat.Add Solu.Value, CStr(Solu.Value)
Next Solu
'poistetaan virheenkäsittely
On Error GoTo 0
'lisätään uniikit tuotenimet A-sarakkeen ekalle tyhjälle riville
For i = 1 To EiTuplat.Count
Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0) = EiTuplat(i)
Next
'haetaan vika rivi tuotenimistä
Vika = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
'luupataan tuotenimet läpi
For Each Solu In Worksheets("Sheet2").Range("A2:A" & Vika)
'haetaan yksikköhinta tuotenimelle
Solu.Offset(0, 1) = HaeArvot2(Solu, Worksheets("Sheet1").Range("A:A"))
'haetaan summattu arvo tuotenimelle
Solu.Offset(0, 2) = HaeArvot(Solu, Worksheets("Sheet1").Range("A:A"))
Next Solu
'tasataan sarakeleveydet pisimmän tekstin mukaan
Worksheets("Sheet2").Columns("A:C").AutoFit
End Sub
Function HaeArvot(Hakuehto As Variant, HakuAlue As Range) As Double
Dim Solu As Range
Dim Ekaosoite As String
'vastaa Excelin omaa etsi funktiota, tosin tässä funktiossa määrittelin palautusarvoksi Double (Excelin omassa Range)...
With HakuAlue
Set Solu = .Find(What:=Hakuehto)
If Not Solu Is Nothing Then
'tallenetaan muuttujaan eka löydetty solun osoite
Ekaosoite = Solu.Address
'luupataan niin kauan kunnes, löydetyn solun osoite eri kuin eka löydetty solun osoite
Do
'summataan löydetyt summat- Solu.Offset(0, 3).Value=D -sarakkeen arvot
HaeArvot = HaeArvot Solu.Offset(0, 3).Value
Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address Ekaosoite
End If
End With
End Function
Function HaeArvot2(Hakuehto As Variant, HakuAlue As Range) As Range
Dim Solu As Range
Dim Ekaosoite As String
'nyt funktio palauttaa Rangen -Solu.Offset(0, 2)= C-sarake
'en jaksanut alkaa muuttelemaaan, joten tää oikeesti palauttaa viimeisen löydetyn tuotenimen yksikköhinnan, oikeaoppisesti olis pitänyt poistella turhat koodista, mutta ei väliä(tällä kertaa yksikköhinta sama)
With HakuAlue
Set Solu = .Find(What:=Hakuehto)
If Not Solu Is Nothing Then
Ekaosoite = Solu.Address
Do
Set HaeArvot2 = Solu.Offset(0, 2)
Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address Ekaosoite
End If
End With
End Function
Keep EXCELing
@Kunde
Mahtavaa settiä löytyy täältä! Itsellä samanlaiset taulukot ja tarve makroille. Kopioinkin tästä suoraan koodin ja lisäsin moduliin. Itsellä kuitenkin antaa virheilmoituksen "syntax error" kohtaan HaeArvot = HaeArvot Solu.Offset(0, 3).Value. Koko rivi on myös punainen samoin kuin rivi "Loop While Not Solu Is Nothing And Solu.Address Ekaosoite". Käytössä on 2016 Excel. Onko hajua miksi antaa virheilmoituksen?
foorumi on hävittänyt koodista erisuuret merkit kummastakin koodista
eli rivit pitäisi olla tällaisia
Loop While Not Solu Is Nothing And Solu.Address (tähäni merkit) Ekaosoite
tähän merkit kohtaan ilman sulkuja siis merkit < ja >
Keep EXCEling
@Kunde
Tuo kirjoittamasi rivi meni normaalin väriseksi mutta edelleen toi ensimmäinen rivi "HaeArvot = HaeArvot Solu.Offset(0, 3).Value" on punaisena ja antaa virheilmoituksen "syntax error".
Hei,
makro näyttää toimivan hienosti muuten mutta oma Excelini ei sulata riviä "HaeArvot = HaeArvot Solu.Offset(0, 3).Value". Rivi on punaisena ja koodin ajo tyssää tuohon. Onko mitään aavistusta missä vika voisi olla?
foorumi hukannut ja- merkin &
eli pitäisi olla
"HaeArvot = HaeArvot (tähän ja- merkki )Solu.Offset(0, 3).Value
tähän merkit kohtaan ilman sulkuja siis ja-merkki &
Keep EXCEling
@Kunde
Kannattaa laittaa koodi Pastebiniin https://pastebin.com/ ja oikean kielen syntaksikorostus päälle. Sitten vaan linkki palstalle. Pääsee vähemmillä väärinkäsityksillä.
Koodit on postattu vuonna 2014 ja silloin ei ollut tommosia ongelmia . Foorumin ulkonäköä fiksailtu ja uusittu sen jälkeen ja koodista kadonnut sitten noita tiettyjä merkkejä...
Ylläpidossa ei päde sääntö "Älä korjaa, jos se ei ole rikki"
Esimerkki:
Jos sinulla on Taul1:sessä tuo mainitsemasi tuoteluettelo
A-sarake "Tuote"
D-sarake "Tilausmäärä"
Tee Taul2:
A1 anna haettavan tuotteen nimi
B1=SUMMA.JOS(Taul1!A:A;A1;Taul1!D:D)
Eli kaava hakee kaikki A1:seen annetun tuotteen vastaavuudet Taul1 A-sarakkeelta ja laskee niitä vastaavat "Tilausmäärät" D-sarakkeelta yhteen
Kaavassa A:A ja D:D tarkoittavat että hakee vastinetta kaikista A ja D sarakkeiden soluista. Jos haluat rajata hakualuetta niin vaikka A1:A1000 ja D1:D1000
Kiitos paljon
Tuo summa.jos toimii moitteetta. Miten jos haluan sen lisäksi tuoda Taul1:sen C sarakkeessa olevan yksikköhinnan. Se pitäisi sijoitta Taul2:n C sarakkeeseen. Eli pitäisi kohdistaa kukin haettu tuote (Taul2, A1 sarake ja siitä eteenpäin) Taul1:ssä olevaan yksikköhintaan, jotka ovat samat olipa rivejä kuinka paljon tahansa , kun vain se kohdistetaan oikeaan tuotteeseen.
Näin minä tekisin.
Kopioi Taul1 A-sarakkeen kaikki "Tuotenimikkeen" sisältävät solut (Valitse solu A1. Paina Ctrl ja Vaihto pohjaan ja paina "nuoli alas" painiketta, kaikki A-sarakkeen dataa sisältävät solut tulevat valituiksi)
Liitä kopioidut solut Taul2 A-sarakkeelle
Kun solut ovat vielä liittämisen jälkeen valittuina niin avaa ylhäältä "Tiedot"-välilehti.
Sieltä löytyy painike "Poista kaksoiskappaleet".
Nyt sinulle jää vain yksi uniikki nimike kutakin.
Taul2 B1=SUMMA.JOS(Taul1!A:A;A1;Taul1!D:D)
Taul2 C1=SUMMA.JOS(Taul1!A:A;A1;Taul1!C:C)
Valitse B1 ja C1 ja vedä kaava alaspäin niinpitkälle kuin tuotteita riittää
Jos käytät rajattua hakualuetta niin laita "dollarimerkit" että hakualue pysyy samana kaikille alaspäin kopioiduille kaavoille ($A$1:$A$1000)
Sori tuli pieni lapsus. Eihän noita yksikköhintoja saa laskea yhteen vaan ne pitää hakea PHAKU-funktiolla. Eli
Taul2 C1=PHAKU(A1:Taul1!A:D;3;0)
Eli kaava hakee A1:sen tuotetta Taul1 A-sarakkeelta ja antaa sitä vastaavan hinnan Taul1 C-sarakkeelta.
PHAKU-funktiossa annetaan ensin haettava (A1), sitten mistä haetaan (Taul1A:D sarakkeilta).
3 tarkoittaa että haetaan alueen A-D 3 sarakkeelta eli C:ltä ja nolla tarkoittaa että haetaan täysin samaa vastaavuutta haettavalta
Tähän on valmis Excel toiminto, ei tarvita mitään ohjelmointia.
Pivot taulukko
http://office.microsoft.com/fi-fi/excel-help/pivot-taulukkoraporttien-perusteet-HA001034632.aspx
Yleensäkin kannattaisi uhrata aikaa ja lukea manuaaleista ohjelmien ominaisuudet / toiminnot.