Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VBA: Excel etsintä-kopiointi-lasku macro

SamSpeed [04.05.2011 07:47:32]

#

Ongelmana on taulukko, jossa x+1 riviä tekstiä ja tarkoitus on, että rivien määrät muuttelevat tilanteen mukaan.

Taulukossa

A              B              C
Tuote          KPL            Total
1              esim 19        19
1.1            2
1.2            1
1.1.1          1
1.jne
1.2.jne
2              esim 30        30
2.2            1
2.jne
lista jatkuu loputtomiin

Eli macro tarvitsisi löytää sarakkeesta A kokonaisluku ja kopioda kyseisen rivin B-sarakkeen kappalemäärä ja kertoa sillä kaikki samalla kokonaisluvulla alkavat desimaalimuotoisten tuotteiden kappalemäärät sarakkeeseen C.
Tuotenumerot vaihtelevat väliltä 1 - 1000000 ja niiden alla voi olla tavaraa, jopa muodossa esim. 1.1.1.1.1

Toivottavasti, joku osaa antaa suuntaa tuohon.

neau33 [05.05.2011 13:08:18]

#

MOI SamSpeed!

tässä koko yksinkertainen paska...

Sub FindAndCobyAndCalculate()

   ReDim MyArray(0) As Variant

   For i = 2 To ActiveSheet.Cells.SpecialCells( _
   xlCellTypeLastCell).Row
      If IsNumeric(Cells(i, 1).Value) And _
      InStr(Cells(i, 1).Text, ".") = 0 Then
         Cells(i, 6).Value = Cells(i, 5).Value
         If CLng(Cells(i, 1).Value) > UBound(MyArray) Then
            ReDim Preserve MyArray(Cells(i, 1).Value)
            MyArray(1, CLng(Cells(i, 1).Value)) = Cells(i, 6).Value
         End If
      ElseIf IsNumeric(Left(Cells(i, 1).Text, 1)) And _
      InStr(Cells(i, 1).Text, ".") > 0 Then
         Cells(i, 6).Value = _
         MyArray(CLng(Left(Cells(i, 1).Text, 1))) _
         * Cells(i, 5).Value
      End If
   Next i

   Erase MyArray

End Sub

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta