Osaisitko auttaa ?

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ä.

VBA ? kirjoitti:

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ä.

Lue lisää

Vaihdoitko taulukoiden nimet Sheet1 ja Sheet2 oikeiksi?

... kirjoitti:

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ä)

... kirjoitti:

Vaihdoitko taulukoiden nimet Sheet1 ja Sheet2 oikeiksi?

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 :)

VBA ? kirjoitti:

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 :)

Lue lisää

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

Kundepuu kirjoitti:

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

Lue lisää

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.

VBA ? kirjoitti:

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.

Lue lisää

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?

Anonyymi kirjoitti:

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?

Lue lisää

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

kunde kirjoitti:

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

Lue lisää

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?

Anonyymi kirjoitti:

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?

Lue lisää

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

kunde kirjoitti:

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

Lue lisää

Kannattaa laittaa koodi Pastebiniin https://pastebin.com/ ja oikean kielen syntaksikorostus päälle. Sitten vaan linkki palstalle. Pääsee vähemmillä väärinkäsityksillä.

Anonyymi kirjoitti:

Kannattaa laittaa koodi Pastebiniin https://pastebin.com/ ja oikean kielen syntaksikorostus päälle. Sitten vaan linkki palstalle. Pääsee vähemmillä väärinkäsityksillä.

Lue lisää

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ä...

kunde kirjoitti:

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ä...

Lue lisää

Ylläpidossa ei päde sääntö "Älä korjaa, jos se ei ole rikki"

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