Ehdollinen siirto toiseen työkirjaan

makrollako

Taul1:ssä on taulukko jonka A-sarakkeessa on päivämäärä, miten saan taul2 haettua määrätyn päivämäärän kaikki rivit?

Yritän saada aikaan jotain tämmöistä: käyttäjä syöttää taul2 soluun A1 haluamansa päivämäärän ja käynnistää makron painikkeesta. Makro tuo haetun päivän rivit taul1:stä taul2:een alkaen solusta A3.

5

558

    Vastaukset 5

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • taulukko2 moduuliin napille koodi

      Private Sub CommandButton1_Click()
      Siirrä
      End Sub

      moduuliin...
      Option Explicit

      Sub Siirrä()
      Dim Löydetty As Range
      Dim haku As Date
      On Error Resume Next
      Application.ScreenUpdating = False
      Worksheets("Sheet2").Activate
      Range("A3:A1000").EntireRow.Clear
      haku = CDate(Range("A1"))
      Set Löydetty = EtsiJaSiirrä(haku, Range("Sheet1!A:A")).EntireRow
      Union(Löydetty, Löydetty).Copy Range("Sheet2!A3")
      Range("A1").Select
      Application.ScreenUpdating = True
      End Sub


      Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
      Dim solu As Range
      Dim EkaOsoite As String

      With HakuAlue
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä = solu
      EkaOsoite = solu.Address
      Do
      Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
      Set solu = .FindNext(solu)
      Loop While Not solu Is Nothing And solu.Address EkaOsoite
      End If
      End With
      Worksheets("Sheet2").Activate
      End Function

      muuttele nimet sopiviksi

      • Tiina K.

        Mainio koodi. Vähän on tilausta samanlaiseen...

        A-sarakkeessa kulkee päivämäärät ja B-E sarakkeella on arvoja.

        Miten saisi tehtyä toiselle sivulle kuvaajan, jossa on syöttö solut alku ja loppu sekä mitä saraketta halutaan kuvattavan. Niihin laitetaan niin se hakee kyseisen alueen luvut ja tekee kuvaajan. Nykyään olen tehnyt piilottelemalla rivejä sen mukaan mitä haluan jne. :)

        Helpottaisi ilkeän pomon nopeita pyyntöjä. Voisin vaikka kokeilla tehdä sitä myös visual basicillä, niin samalla tulisi sekin tutuksi.


      • makrollako

        Kiitos vastauksesta. Valitettavasti ehdin testata tätä vasta ensi viikolla, mutta eiköhän tuo ole juuri sitä mitä haen.


      • Tiina K. kirjoitti:

        Mainio koodi. Vähän on tilausta samanlaiseen...

        A-sarakkeessa kulkee päivämäärät ja B-E sarakkeella on arvoja.

        Miten saisi tehtyä toiselle sivulle kuvaajan, jossa on syöttö solut alku ja loppu sekä mitä saraketta halutaan kuvattavan. Niihin laitetaan niin se hakee kyseisen alueen luvut ja tekee kuvaajan. Nykyään olen tehnyt piilottelemalla rivejä sen mukaan mitä haluan jne. :)

        Helpottaisi ilkeän pomon nopeita pyyntöjä. Voisin vaikka kokeilla tehdä sitä myös visual basicillä, niin samalla tulisi sekin tutuksi.

        moduuliin...
        ja liitä koodi nappiin

        muuttele nimet sopiviksi ja nauhoita makro , jolla saat oikean kaaviotyypin...
        nyt
        sheet2 solut D(alkupvm),E(loppupvm),F(mikä sarake näytetään) syöttösoluina ja tiedot sheet1 sarakkeet A-D


      • kunde kirjoitti:

        moduuliin...
        ja liitä koodi nappiin

        muuttele nimet sopiviksi ja nauhoita makro , jolla saat oikean kaaviotyypin...
        nyt
        sheet2 solut D(alkupvm),E(loppupvm),F(mikä sarake näytetään) syöttösoluina ja tiedot sheet1 sarakkeet A-D

        moduuliin...

        Sub SuodataJaTeeKaavio()
        Dim dAlku As Date
        Dim dLoppu As Date
        Dim lAlku As Long
        Dim lLoppu As Long
        Dim Näytä As String
        Dim vika As Integer
        Dim kaavio As ChartObject
        Dim Kaaviot As ChartObjects
        On Error Resume Next
        Application.ScreenUpdating = False
        Worksheets("Sheet2").Activate
        For Each kaavio In ActiveSheet.ChartObjects
        kaavio.Select
        kaavio.Delete
        Next
        Columns("A:B").Clear
        Näytä = Range("F1")
        If IsDate(Range("D1")) Then
        dAlku = Range("D1")
        dAlku = DateSerial(Year(dAlku), Month(dAlku), Day(dAlku))
        lAlku = dAlku
        End If
        If IsDate(Range("E1")) Then
        dLoppu = Range("E1")
        dLoppu = DateSerial(Year(dLoppu), Month(dLoppu), Day(dLoppu))
        lLoppu = dLoppu
        End If
        Worksheets("Sheet1").Activate
        With Sheet1
        .AutoFilterMode = False
        .Range("A:D").AutoFilter
        .Range("A:D").AutoFilter Field:=1, Criteria1:=">=" & lAlku, Operator:=xlAnd, Criteria2:="


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Onko vassarin lääkkeet(mt) jääneet taas ottamatta

      Sen verran järjetöntä persuhuutoa taa näkyville. Tuo yksi häiriintynyt ei osaa kuin "huutaa" isoilla kirjaimilla, se on
      Maailman menoa
      3
      1083
    2. Kuinkahan monen

      Naisen puolisoa olet nainen vikitellyt ja eron aiheuttanut? Toivottavasti karma on ku*sut muroihisi useamman kuin kerran
      Ikävä
      104
      1030
    3. Mies, kumman ottaisit mieluummin

      176 cm vai 154 cm naisen, jos molemmat muuten yhtä viehättäviä? Mikä on oma pituutesi?
      Sinkut
      166
      1004
    4. Kauan mökötetään toisillemme?

      Loppuelämäkö? Vai oisko jo pussailutreffit?
      Ikävä
      65
      765
    5. Pettymys TTK-parketilla! Anna Hanski tippui - Sami-opelta erikoinen heitto: "Nyt sä pääset..."

      Toisena parina Tanssii Tähtien Kanssa -kisasta tippuivat Anna Hanski ja Sami Helenius. Pettymys oli käsinkosketeltava y
      Tanssii tähtien kanssa
      27
      709
    6. Tekisi mieli vetäistä kunnon jurrit sinun kanssasi

      Ja keskustella asiat, ei tästä tule hevonvttua.
      Ikävä
      50
      707
    7. Anteeksi mies

      En jaksa tätä…, en halua, että sinulla on paha mieli tämän takia. Viestiä Sinulle.
      Ikävä
      47
      704
    8. Olen nainen pahoillani, että tykkään sinusta niin paljon, että

      Haluaisin panna sua. Tuntuu vaan siltä, että olet sen suhteen ihan haluton. Ei minulle riitä pelkkä ystävyyssuhde.
      Ikävä
      46
      663
    9. Eikö olisi mukavaa

      Jakaa arki yhdessä mies. Tämmöisin aatoksin.
      Ikävä
      50
      638
    10. Mieti oikeasti

      Ollaan lähes tuntemattomia, mutta samalla on tämä erityinen vuosien tilanne takana, joka on ollut monella tapaa väärin.
      Ikävä
      30
      597
    11. Poliisi etsii kadonnutta henkilöä Lapualla

      Henkilö on kadonnut 18-19.9.2026 välisenä yönä. Henkilö on hoikka,n 185 cm pitkä. Kadonneella on ollut katoamishetkellä
      Lapua
      32
      592
    12. Venäjä häviämässä 30 vuoden sodan

      Ukraina vapautti kolme aluetta, operaatio Vivaldi laajenee
      Maailman menoa
      516
      589
    13. Oot komea

      etkä näytä vanhenevan. Mieskarkki. Mä en yritä mitään, mä oon sulle liian vanha. Olis kuitenkin kiva tutustua suhun. n
      Ikävä
      20
      553
    14. Laittaisit viestin suoraan!!

      Haluaisin...
      Ikävä
      31
      541
    15. Taasko sä vedit

      Suojamoodin päälle? Miehelle
      Ikävä
      74
      525
    16. Jonkun mussukka ajanu rallia

      S- Marketilla. Vautsi vau.
      Hyrynsalmi
      6
      516
    17. Tiedoksi yhdelle naiselle

      että mies lähestyy kaikin tavoin jos on kiinnostunut! 🙋🏻‍♂️
      Ikävä
      43
      513
    18. Se oli molemminpuolinen limerenssi

      Limerenssi myös sinulla kun näin pitkän ajan jälkeen päivystää palstaa. 🤭
      Ikävä
      81
      499
    19. kene ajoi "kolarin"?

      "Punkaharjulla Luston ja Tuppuranmäen välillä sattui tiistaina aamupäivällä liikenneonnettomuus. Poliisin mukaan Savonl
      Savonlinna
      14
      495
    20. Minä kyllä odotan nainen

      että sinun kanssa voisin jutella asioista ihan oikeasti.
      Ikävä
      44
      491
    Aihe