Rekisteröidy

Ilmoitukset

Ladataan…

    Näytä kaikki

    keveyttä toimintaan

    Tervehdys,

    Haluaisin vähän parantaa tuossa alla olevan koodi rivistön suoritus aikaa,eli kyseinen pätkä tekee sen mitä tarvitaan, mutta aikaa suorittamiseen meni n. tunti.

    eli mulla on soluissa b2-b3009 asiakkaiden tunnukset vuodelta 2004. soluissa h2-h9943 mulla on vuoden 2006 asiakkaat. ja nyt haluan verrata että ketkä asiakkaista on olleet 2004 ja ovat vieläkin jäljellä =) eli alla oleva ohjelma tekee seuraavaa: jos solussa b2 oleva arvo = h2-h10000 niin kopioidaan h,i,j solut laskurin kohdata laskuri2 d,e,f soluihin.

    Mutta ongelmana on tosiaan tuo hitaus mitenkäs olisko jotain nopeempaa koodia/ valista excelin komentoa tälle

    Tässä vielä koodi:

    Sub main()

    For laskuri2 = 2 To 3010

    For laskuri = 2 To 10000

    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("d" & laskuri2) = Range("h" & laskuri)
    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("e" & laskuri2) = Range("i" & laskuri)
    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("f" & laskuri2) = Range("g" & laskuri)
    Next
    Next

    End Sub


    kiitos avustanne
    7685
    Äänestä

    Muut lukivat myös

    Vastaukset 7

    Vanhimmat

    Kannattaa ainakin laittaa näytön päivitys pois päältä, eli Application.ScreenUpdating = False.
    Koodin lopuksi taas päälle: Application.ScreenUpdating = True. Tämä nopeuttaa jonkin verran, minua viisaammilla voi olla oikeastikin tehokkaita konsteja mutta tämä tuli näin pikaisesti mieleen. Alla muokattu koodi:


    Sub main()

    Application.ScreenUpdating = False

    For laskuri2 = 2 To 3010

    For laskuri = 2 To 10000

    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("d" & laskuri2) = Range("h" & laskuri)
    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("e" & laskuri2) = Range("i" & laskuri)
    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("f" & laskuri2) = Range("g" & laskuri)
    Next
    Next

    Application.ScreenUpdating = True

    End Sub

    -Pasi-

    Äänestä

    Sub main()

    Application.ScreenUpdating = False
    For laskuri2 = 2 To 3010
    For laskuri = 2 To 10000
    If Range("b" & laskuri2) = Range("h" & laskuri) Then
    Range("d" & laskuri2) = Range("h" & laskuri)
    Range("e" & laskuri2) = Range("i" & laskuri)
    Range("f" & laskuri2) = Range("g" & laskuri)
    End If
    Next
    Next
    Application.ScreenUpdating = True

    End Sub

    -Pasi-

    Äänestä

    unohda nyt kuitenkin tuo edellinen... Tässä:

    Sub main()

    Application.ScreenUpdating = False
    For laskuri2 = 2 To 3010
    For laskuri = 2 To 10002 - laskuri2
    If Range("b" & laskuri2) = Range("h" & laskuri) Then
    Range("d" & laskuri2) = Range("h" & laskuri)
    Range("e" & laskuri2) = Range("i" & laskuri)
    Range("f" & laskuri2) = Range("g" & laskuri)
    End If
    Next
    Next
    Application.ScreenUpdating = True

    End Sub

    Äänestä

    En ole varma onko just sitä mitä halusit mutta räätälöimällä saat helposti muokattua

    Sub Testi()
    Dim vika As Double
    Dim vika2 As Double
    Application.ScreenUpdating = False
    vika = Range("A65536").End(xlUp).Row
    vika2 = Range("H65536").End(xlUp).Row
    Range("D4:F" & vika) = ""
    Range("D4").FormulaArray = "=IF(COUNTIF(R4C1:R20000C1,RC[4])>0,RC[4],"""")"
    Range("D4").AutoFill Destination:=Range("D4:D" & vika), Type:=xlFillDefault

    Range("E4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],R4C8:R20000C10,2)),"""",VLOOKUP(RC[-1],R4C8:R20000C10,2))"
    Range("E4").AutoFill Destination:=Range("E4:E" & vika2), Type:=xlFillDefault

    Range("F4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],R4C8:R20000C10,3)),"""",VLOOKUP(RC[-2],R4C8:R20000C10,3))"
    Range("F4").AutoFill Destination:=Range("F4:F" & vika2), Type:=xlFillDefault
    Range("D4:F" & vika2).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("A1").Select
    Application.ScreenUpdating = True
    End Sub

    Äänestä

    • lisäsin vielä laskenta jutun ja nyt suorittaa alle 3 sekunnin 10000 riviä tietoa, joten nopeutuminen on biturbo luokkaa...

      Sub Testi()
      Dim vika As Double
      Dim vika2 As Double
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      vika = Range("A65536").End(xlUp).Row
      vika2 = Range("H65536").End(xlUp).Row
      Range("D4:F" & vika) = ""
      Range("D4").FormulaArray = "=IF(COUNTIF(R4C1:R20000C1,RC[4])>0,RC[4],"""")"
      Range("D4").AutoFill Destination:=Range("D4:D" & vika), Type:=xlFillDefault

      Range("E4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],R4C8:R20000C10,2)),"""",VLOOKUP(RC[-1],R4C8:R20000C10,2))"
      Range("E4").AutoFill Destination:=Range("E4:E" & vika2), Type:=xlFillDefault

      Range("F4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],R4C8:R20000C10,3)),"""",VLOOKUP(RC[-2],R4C8:R20000C10,3))"
      Range("F4").AutoFill Destination:=Range("F4:F" & vika2), Type:=xlFillDefault
      Range("D4:F" & vika2).Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False

      Range("A1").Select
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
      End Sub

      Äänestä

    • Kunde kirjoitti:

      lisäsin vielä laskenta jutun ja nyt suorittaa alle 3 sekunnin 10000 riviä tietoa, joten nopeutuminen on biturbo luokkaa...

      Sub Testi()
      Dim vika As Double
      Dim vika2 As Double
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      vika = Range("A65536").End(xlUp).Row
      vika2 = Range("H65536").End(xlUp).Row
      Range("D4:F" & vika) = ""
      Range("D4").FormulaArray = "=IF(COUNTIF(R4C1:R20000C1,RC[4])>0,RC[4],"""")"
      Range("D4").AutoFill Destination:=Range("D4:D" & vika), Type:=xlFillDefault

      Range("E4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],R4C8:R20000C10,2)),"""",VLOOKUP(RC[-1],R4C8:R20000C10,2))"
      Range("E4").AutoFill Destination:=Range("E4:E" & vika2), Type:=xlFillDefault

      Range("F4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],R4C8:R20000C10,3)),"""",VLOOKUP(RC[-2],R4C8:R20000C10,3))"
      Range("F4").AutoFill Destination:=Range("F4:F" & vika2), Type:=xlFillDefault
      Range("D4:F" & vika2).Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False

      Range("A1").Select
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
      End Sub

      taas nolottaa myöntää mutta modaaminen ei onnistu kun ei ymmärrä mitä koodi tekee =) muutoin aika selväää, mutta mitä tarkoittaakaan:

      Range("D4").FormulaArray = "=IF(COUNTIF(R4C1:R20000C1,RC[4])>0,RC[4],"""")"
      Range("D4").AutoFill Destination:=Range("D4:D" & vika), Type:=xlFillDefault

      en saa tuosta mitään tolkkua. jos vielä jaksamista riittää niin viititkö jeesata. loppu varmaan aukeeaa kunhan tuon saa selville.

      ---niin siis ei toiminut---

      Eli ideahan oli jos soluista b2-b:n vikasta löytyvä tieto löytyy myös solusta h2 - h:n viimoinen solu niin kopioidaan se kyseinen H solu sekä viereiset vastaavat g ja i solu, d, e, f soluihin... en enää itekkään pysy perässä

      mutta tältä se siis näyttää

      .....a.....b.....c....d....e....f....g.....h.....i
      1
      2 . ma...005...4 ... .... ..... ...pe...001.. 6
      3 . de...007...8 ... .... ..... ...ma...005.. 12
      4 . ti...102...10 .. .... ..... ...ju...006.. 35
      5 . ju...006...8 ... .... ..... ...se...008.. 5

      Eli tarkastetaan solu b2, mikäli b2 = h2-h10000 niin kopioidaan g2,h2 ja i2 kohtaan d2,e2,ja f2. tuossa esimerkissä d2 olisi siis ma . e2 olisi 005 ja f2 olisi 12. seuraavat solut olisivat tyhjiä koska vastaavaa tietoa ei löydy. vasta d5, e5 ja f5 saisivat arvon ju, 006 ja 35

      En pysy enää itsekkään perässä, toivottavasti te pysytte. kiitos avusta =)

      Äänestä

    • Kunde kirjoitti:

      lisäsin vielä laskenta jutun ja nyt suorittaa alle 3 sekunnin 10000 riviä tietoa, joten nopeutuminen on biturbo luokkaa...

      Sub Testi()
      Dim vika As Double
      Dim vika2 As Double
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      vika = Range("A65536").End(xlUp).Row
      vika2 = Range("H65536").End(xlUp).Row
      Range("D4:F" & vika) = ""
      Range("D4").FormulaArray = "=IF(COUNTIF(R4C1:R20000C1,RC[4])>0,RC[4],"""")"
      Range("D4").AutoFill Destination:=Range("D4:D" & vika), Type:=xlFillDefault

      Range("E4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],R4C8:R20000C10,2)),"""",VLOOKUP(RC[-1],R4C8:R20000C10,2))"
      Range("E4").AutoFill Destination:=Range("E4:E" & vika2), Type:=xlFillDefault

      Range("F4").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],R4C8:R20000C10,3)),"""",VLOOKUP(RC[-2],R4C8:R20000C10,3))"
      Range("F4").AutoFill Destination:=Range("F4:F" & vika2), Type:=xlFillDefault
      Range("D4:F" & vika2).Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      Application.CutCopyMode = False

      Range("A1").Select
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
      End Sub

      ei ole nyt exceliä tällä koneella, joten ulkomuistista
      näkyy olevan turhia juttujakin vielä koodissa...

      Range("D4").FormulaArray = "=IF(COUNTIF(R4C1:R20000C1,RC[4])>0,RC[4],"""")"
      Range("D4").AutoFill Destination:=Range("D4:D" & vika), Type:=xlFillDefault

      tekee matriisikaavan soluun D4 ja sitten täyttää alueen D4:D vika kaavalla
      tuo kaava hakee yhteiset asiakasnumerot sarakkeen G asiakasnumeroista

      ohjelman kulku on seuraava:

      kuvaruutupäivitys pois päältä
      manuaalilaskenta päälle
      etsitään vika A-sarakkeesta
      etsitään vika H -sarakkeesta- turha
      tyhjennetään alue D4:D & vika
      tehdään matriisikaava D4 (hakee yhteiset asiakasnumerot listasta)
      kopioidaan D4;D & vika asti
      tehdää PHAKU kaava E4
      kopioidaan D4;D & vika asti -turhaan muuten toi vika2 vika riittää
      tehdää PHAKU kaava F4
      kopioidaan F4;D & vika asti turhaan muuten toi vika2 vika riittää
      tän nyt lisäsin varmuuden vuoksi,ettei vahingossa poista kaavaa...
      kopioidaan kaavat ja muutetan arvoiksi
      kuvaruutupäivitys päälle
      automaattilaskenta päälle

      Äänestä

    Odottaa vastausta

    Näihin keskusteluihin ei ole vielä vastattu. Ole ensimmäinen.

    Luetuimmat keskustelut

    Kommentoi aloitusta

    remec kirjoitti:

    Tervehdys,

    Haluaisin vähän parantaa tuossa alla olevan koodi rivistön suoritus aikaa,eli kyseinen pätkä tekee sen mitä tarvitaan, mutta aikaa suorittamiseen meni n. tunti.

    eli mulla on soluissa b2-b3009 asiakkaiden tunnukset vuodelta 2004. soluissa h2-h9943 mulla on vuoden 2006 asiakkaat. ja nyt haluan verrata että ketkä asiakkaista on olleet 2004 ja ovat vieläkin jäljellä =) eli alla oleva ohjelma tekee seuraavaa: jos solussa b2 oleva arvo = h2-h10000 niin kopioidaan h,i,j solut laskurin kohdata laskuri2 d,e,f soluihin.

    Mutta ongelmana on tosiaan tuo hitaus mitenkäs olisko jotain nopeempaa koodia/ valista excelin komentoa tälle

    Tässä vielä koodi:

    Sub main()

    For laskuri2 = 2 To 3010

    For laskuri = 2 To 10000

    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("d" & laskuri2) = Range("h" & laskuri)
    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("e" & laskuri2) = Range("i" & laskuri)
    If Range("b" & laskuri2) = Range("h" & laskuri) Then Range("f" & laskuri2) = Range("g" & laskuri)
    Next
    Next

    End Sub


    kiitos avustanne

    Anonyymi
    5000

    Ilmoita asiaton sisältö

    • Sisältää materiaalia, joka on loukkaavaa, herjaavaa, rasistista, uhkailevaa tai ahdistelevaa.

    • Materiaali sisältää nimiä, yhteystietoja tai muita henkilökohtaisia tietoja. Julkisuuden henkilöistä, julkisissa viroissa toimivista ihmisistä sekä yritysten vastuuhenkilöistä saa keskustella työhön liittyen. Myös yksityiselämään liittyvistä asioista voi keskustella siltä osin, kuin niistä on julkisesti kerrottu.

    • Sisältää lapsille haitallista tai heiltä kiellettyä materiaalia. Seksuaalinen sisältö on sallittua aiheeseen tarkoitetuilla palstoilla, joiden ikäraja on 18 vuotta.

    • Lainvastaista sisältöä voi olla mm. yksityiselämää loukkaavan tiedon levitys, kiihottaminen kansanryhmää vastaan, laiton uhkaaminen, alaikäisiin liittyvä seksuaalinen sisältö/grooming, petokset, identiteettivarkaudet, kunnianloukkaukset ja tekijänoikeusrikkomukset.

    • Sisältö ei liity palstan tai keskusteluketjun aiheeseen.

    • Viesti ei ole suomea tai ruotsia (pl. International Forums), se sisältää mainontaa, se sisältää tekijänoikeuksin suojattua materiaalia, se on massapostitus tai jokin muu syy.

    Jaa keskustelu