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

519

    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. Mitä tapahtunut

      Poliiseja monta autoa+panssariauto Porista kpäähän päin tänään klo n.20 kuka hurjistunut ?
      Kankaanpää
      46
      5751
    2. Lakea konkurssiin. Asukkaat menettävät asuntonsa

      Kuntarahoitus on tänään jättänyt konkurssihakemuksen lakean kaikista kiinteistö osakeyhtiöistä. Kassa on tyhjä, kaikki
      Seinäjoki
      55
      3035
    3. Gallup: kaivattusi syntymävuosi

      Minä vuonna kaipaamasi henkilö on syntynyt?
      Ikävä
      183
      2645
    4. Nikkalassa vauhdilla nokka kohti taivasta

      Mitähän Darwin sanoisi näistä 4 suomalaisesta, jotka kävivät Haparandan puolella näyttämässä, kuinka Suomi auto kulkee t
      Tornio ja Haaparanta
      10
      2341
    5. Missäpäin,,,

      Lapuaa tapettu ihminen viime yönä ? Hurjaa touhua nykymeno täällä...
      Lapua
      27
      2083
    6. mahdollista, että olet ollut iltavuorossa

      Ja kotiin päästyäsi tulit palstalle etsimään merkkiä minusta, jos kaipaat yhtään minua niin kuin minä sinua Ei mennyt k
      Ikävä
      13
      2079
    7. törniöläiset kaaharit haaparannassa

      isäpapan autolla kaahatta 270 km/h metsään https://www.lapinkansa.fi/nsd-kaksi-suomalaista-kuoli-kolarissa-haaparannall/
      Tornio ja Haaparanta
      15
      1756
    8. Mitähän ne katseet merkitsee

      Kun et saa sanaa suustasi.
      Ikävä
      146
      1337
    9. Upea peppuisella naisella

      Upea peppuisella naisella on upea peppu.
      Ikävä
      14
      1289
    10. Sitä saa mitä tilaa Perussuomalaiset!

      https://yle.fi/a/74-20160212 SDP:n kannatus se vain nousee ja Keskusta on kolmantena. Kokoomus saanut pienen osan persu
      Maailman menoa
      261
      1153
    Aihe