Autofilter Field kohtaan kaava

yks.kysymys

Moi.
Minulla on 1 rivillä päivämääriä, ja sen alla soluja eri väreillä.

Miten saan napin autofiltertoiminnon toimimaan siten että se suodattaa tämän päivän kohdan tietyllä värillä olevat rivit?

Sain sillä tavalla toimimaan että sarakenumero on tietty (Field:=8)
Miten saan sen että nappi valitsee tämän päivän kohdalta sarakkeen (esim. AA1) ja suodattaa siitä punaisella värillä olevat solut (eli Field: ( tilalle AA1 vaastaava sarake tänään, huomenna AB1 sarake, jne

Private Sub ToggleButton1_Click()

If ToggleButton1.Value = True Then
On Error Resume Next
ActiveSheet.Range("$A$8:$CDZ$95").AutoFilter Field:=8, Criteria1:=RGB(255, 0 _
, 0), Operator:=xlFilterCellColor


Else
On Error Resume Next
ActiveSheet.Shapes.Range(Array("ToggleButton1")).Select
ActiveSheet.Range("$A$8:$CDZ$95").AutoFilter Field:=8

End If
End Sub

6

270

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      automaatisesti löydät sarakkeen VBA:ssa
      Application.WorksheetFunction.Match(cdbl(Date), Range("8:8"))

      Keep EXCEling
      @Kunde

    • yks.kysymys

      Kyseessä on siis aikataulu, jossa eri tapahtumien soluja eri väreillä
      Siis päivämäärät ovat rivillä 1
      tapahtumat ovat alla olevilla riveillä vuoden ajalta, eli sarakkeet B:NB

      Tarkoitin sellaista toimintoa että nappia alas painamalla näkyisi vain tämän päivän kohdalla vaikkapa punaisella värillä merkityt tapahtumat, eli valitaan sarakke tämän päivän kohdalta, ja siitä sarakkeesta suodatetaan punaiset solut eri riveiltä.

      Sain tehtyä napin joka hakee tämän päivän mutta että samalla napilla vielä samalla suodattaisi värin mukaan...

    • kunde

      jos antamasi kaava toimii niin kuten sanoin postauksessani löydät oikean sarakkeen ko päivänä
      Application.WorksheetFunction.Match(cdbl(Date), Range("8:8"))...

      lisättynä toimivaan koodiisi

      Private Sub ToggleButton1_Click()
      On Error Resume Next
      If ToggleButton1.Value = True Then

      ActiveSheet.Range("$A$8:$CDZ$95").AutoFilter Field:=Application.WorksheetFunction.Match(CDbl(Date), Range("1:1")), Criteria1:=RGB(255, 0 _
      , 0), Operator:=xlFilterCellColor

      Else

      ActiveSheet.Shapes.Range(Array("ToggleButton1")).Select
      ActiveSheet.Range("$A$8:$CDZ$95").AutoFilter Field:=Application.WorksheetFunction.Match(CDbl(Date), Range("1:1"))

      End If
      End Sub

      Keep EXCEling
      @Kunde

      • yks.kysymys

        Kiitos.
        Saisiko vielä suodatusta niin että se valitsisi kaikki muut värit paitsi valkoisen.
        En saanut erisuuri merkkiä (<>) toimimaan = merkin tilalla

      • yks.kysymys

        Tällainen koodi ei siis toimi:
        Criteria1:<>RGB(255, 255, 255), Operator:=xlFilterCellColor

        Mikä toimisi jotta suodattaisi muut paitsi valkoiset?

    • Kundepuu

      väreillä hiukan vaikeempaa, mutta lisäämällä apusarakkeen ja siihen koodaamalla värikoodit ja arvojen perusteella voi sitten suodattaa(-4142 on ei täyttöä ja värit sitten positiivisiä) , eli nyt lisäsin CEA sarakkeen suodatusalueeseen ja sitä hyödynsin... ;-)
      muuta tarvittaessa sarake koodiin
      sarake CAE on Field:=2159


      Private Sub ToggleButton1_Click()
      Dim Sarake As Long
      Dim i As Long

      On Error Resume Next
      If ToggleButton1.Value = True Then
      Range("CEA:CEA") = ""
      Sarake = Application.WorksheetFunction.Match(CDbl(Date), Range("1:1"))
      For i = 9 To 95
      Range("CEA" & i) = Cells(i, Sarake).Interior.ColorIndex

      Next
      ActiveSheet.Range("$A$8:$CEA$95").AutoFilter Field:=2159, Criteria1:=">0"

      Else

      ActiveSheet.Shapes.Range(Array("ToggleButton1")).Select
      ActiveSheet.Range("$A$8:$CEA$95").AutoFilter Field:=Sarake
      End If
      End Sub

      Keep EXCEling
      @Kunde

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. En minä kyllä enää odota sinua

      Olet siellä sen harmaan kanssa. Niin, annoit minun nähdä lämpimät tunteesi siitä huolimatta. Se merkitsi kyllä paljon. O
      Ikävä
      40
      2042

    2. Taas pedofiliatuomio Haapaveelle

      Vastenmielisiä ja vakavia rikostapauksia pikkupaikkakunnan alueellekin näyttää riittävän. Tämän alan rikoksien tuomiot
      Haapavesi
      41
      1837

    3. Jos joku luulee että kaikki käy

      Sanon vain tämän. Minun kanssani ei neuvotella. Minun kanssani eletään tasavertaisesti. Jos se on liikaa, niin ovi rinn
      Ikävä
      61
      1525

    4. Joka kolmas työtön on työkyvytön

      Viime vuonna työnhakuvelvoitteen ulkopuolella oli noin kolmannes työttömistä työnhakijoista. Huhheijaa, mihin suomalais
      Maailman menoa
      183
      1456

    5. Sakin hivutus - ilmiö

      Miten tuollainen tuollainen ilmiö kuin ”sakin hivutus” syntyy? Mitä syitä ilmiön syntymiseen tarvitaan? Onko sakissa jok
      80 plus
      69
      1251

    6. Ei ole rohkeutta tulla jututtamaan

      Voidaan me nähdä ja tervehtiä, sitäkin harvoin, mutta iso kynnys on edes mennä lähelle ja kysyä kuulumisia. Ymmärrät var
      Tunteet
      8
      1231

    7. Julkinen saunatilanne Haapavedellä, tämä on täyttä paskaa!

      Eilen Haapaveden uimahallin saunassa koettu tilanne oli täysin käsittämätöntä ja helvetin järkyttävää. Ladyboy harjoitti
      Haapavesi
      19
      1003

    8. Mitä tapahtuu?

      Mitä säpäkän risteyksessä on tapahtunut kun poliiseja, ambulansseja ja kopteri paikalla?
      Outokumpu
      18
      975

    9. Me ei voida olla yhdessä

      Järki päähän ja realiteetit huomioon ottaen.
      Ikävä
      63
      954

    10. Kuhmon K-kaupan vanhenevat hapannaamat kassoilla

      Pitemmän aikaa olen ihmetellyt kaverin kanssa miksi Kuhmon K-kaupassa on aina tympeimmät kassattöntekijät? Kesällä tulee
      Kuhmo
      14
      885
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt