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

526

    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. Ketä ikävöit?

      Tuntomerkkejä jos täällä oikeat kohtaavat❤️
      Ikävä
      160
      3489
    2. Juniorivalmennus Jokereissa..

      Mitä hittoa siellä seurassa oikein tapahtuu?? Tämän kauden U14 ikäluokkaan on mahdutettu kaksi päävalmentajaa. Tälle kau
      Nuorten jääkiekko
      61
      2735
    3. Ammuskelua taas

      Keskipohjanmaa tietää kertoa että Yläpubin hujakoilla ammuskeltu lauantain vastaisena yönä.
      Kokkola
      33
      2120
    4. Et saa mua ikinä

      Oma vikasi. Naiselta.
      Ikävä
      130
      1687
    5. Päivämääriä

      Minä päivämääränä näit kaivattusi viimeksi?
      Ikävä
      80
      1583
    6. Seksikkäin asu mikä päällä olet nähnyt kaivattusi ?

      Seksikkäin asu mikä yllä olet nähnyt kaivattusi ?
      Ikävä
      83
      1544
    7. Introverttinä osastolla

      Yhdellä lääkäritapaamisella hoitaja valitti lääkärille etten tee mitään muuta kuin makaan ja ulkoilen. Kävin kuitenkin s
      368
      1472
    8. Kerro mulle mitä pitäs tehdä

      Sun mielestä? Anna neuvo?
      Ikävä
      97
      1215
    9. Toivotko, että

      hän tulisi juttelemaan sinulle, vai lähestytkö mieluummin itse?
      Ikävä
      89
      1125
    10. On tullut aika lukita kaupunginjohtajan ovi, ja hlö pihalle

      Ei kahta eikä yhtäkään selitystä, ylimielisyys on kääntyi varomattomuudeksi, ja kaupungin jo ennestään kuihtuva talou
      Pyhäjärvi
      195
      1106
    Aihe