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

523

    Vastaukset

    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. Laitetaas nyt kirjaimet tänne

      kuka kaipaa ja ketä ?
      Ikävä
      82
      6345
    2. Useita puukotettu Tampereella

      Mikäs homma tämä nyt taas on? "Useaa henkilöä on puukotettu Tampereen keskustassa kauppakeskus Ratinan lähistöllä." ht
      Tampere
      289
      5440
    3. Kuka rääkkää eläimiä Puolangalla?

      Poliisi ampui toistakymmentä nälkiintynyttä eläintä Puolangalla Tilalta oli ollut karkuteillä lähes viisikymmentä nälkii
      Puolanka
      98
      4131
    4. Leipivaaran päällä on kuoleman hiljaista.

      Suru vai suuri helpotus...
      Puolanka
      52
      2890
    5. Pieni häivähdys sinusta

      Olet niin totinen
      Ikävä
      26
      2832
    6. Koska näit kaivattusi viimeksi

      Milloin tapasit rakkaasi? Ja etenikö suhde yhtään?
      Ikävä
      120
      2083
    7. Meneeköhän sulla

      oikeasti pinnan alla yhtä huonosti kuin mulla? Tai yhtä huonosti mutta jollain eri tyylillä? Ei olisi pitänyt jättää sua
      Ikävä
      47
      2030
    8. Lähetä terveisesi kaipaamallesi henkilölle

      Vauva-palstalta tuttua kaipaamista uudessa ympäristössä. Kaipuu jatkukoon 💘
      Ikävä
      99
      1767
    9. Tekiskö nainen mieli tavata...

      Viikonloppuna ja...?
      Ikävä
      72
      1291
    10. PS uusimman gallupin rakettimainen nousija

      https://yle.fi/a/74-20170641 Aivan ylivoimaisesti suurin kannatuksen nousu PS:lle. Nousu on alkanut ja jatkuu 2 vuoden
      Maailman menoa
      159
      1151
    Aihe