Keskustelu: Ohjelmointikysymykset: VBA: Rivien piilottaminen Excelissä

Private Sub CommandButton2_Click()

  ' oletetaan että tyokirjan taulussa
  ' on tekstiruutu ja komentopainike

  ' estetään näytön päivittyminen
  Application.ScreenUpdating = False

  ' jos tekstiruutu ei ole tyhjä niin...
  If TextBox1.Text <> "" Then

    ' oletetaan että, datarivit alkavat riviltä 5
    ' (edeltävillä riveillä on otsikkotietoja yms.)

    Dim ekarivi As Long, vikarivi As Long
    ekarivi = 5

    ' poimitaan muuttujan vikarivi arvoksi aktiivisen
    ' taulun käytössä olevan alueen viimenisen rivin indeksi

    vikarivi = ActiveSheet.Cells. _
    SpecialCells(xlCellTypeLastCell).Row

    ' valitaan kaikki taulun solut
    Cells.Select
    ' ja näytetään kaikki solut
    Selection.EntireRow.Hidden = False

    For i = ekarivi To vikarivi

        ' valitaan laskurin (i) arvon osoittamalta
        ' riviltä, sarakkeen 1 solu
        Cells(i, 1).Select

        ' jos valitun solun tekstiarvo on eri,
        ' kuin tekstiruudun tekstiarvo
        If Cells(i, 1).Text <> TextBox1.Text Then
            ' niin piilotetaan koko rivi
            Selection.EntireRow.Hidden = True
        End If
    Next i

   ' tyhjennetään tekstiruutu
   TextBox1.Text = "": Cells(1, 1).Select

  ' muutoin
  Else

    ' valitaan kaikki (aktiivisen) taulun solut
    Cells.Select
    ' ja näytetään kaikki solut
    Selection.EntireRow.Hidden = False
  End If

  ' valitaan ensimäinen solu
  TextBox1.Text = "": Cells(1, 1).Select

  ' sallitaan näytön päivittyminen
  Application.ScreenUpdating = True

End Sub

' Module1

' täytetään valintalista työkirjan avaamisen yhteydessä
Sub auto_open()
Sheets("KOONTI").ListBox1.Clear
   If Sheets("KOONTI").ListBox1.ListCount = 0 Then

      Dim itemStr As String
      itemStr = "Koko vuosi,Tammikuu,Helmikuu," & _
      "Maaliskuu,Huhtikuu,Toukokuu,Kesäkuu,Heinäkuu," & _
      "Elokuu,Syyskuu,Lokakuu,Marraskuu,Joulukuu"

      Dim itemArray() As String
      itemArray = Split(itemStr, ",")
      Sheets("KOONTI").ListBox1.List = itemArray
      Erase itemArray: itemStr = ""

   End If

End Sub

'Taul1 (KOONTI)
Private Sub CommandButton1_Click()

   Application.ScreenUpdating = False

      Dim dataRivit As Long
      Dim dataEkarivi As Long
      Dim dataSarakkeet As Long
      Dim koontiEkarivi As Long
      Dim koontiRivit As Long
      Dim rivilaskuri As Long

      ' oletetaan että datataulun ensimmäinen hakurivi on 3
      dataEkarivi = 3

      ' oletetaan, että tuodaan dataa sarakkeista 1 - 10
      dataSarakkeet = 10

      dataRivit = _
      Sheets("DATA").UsedRange.Rows.Count

      ' jos muuttujan dataRivit arvo on pienempi,
      ' kuin muuttujan dataEkarivi arvo niin...
      If dataRivit < dataEkarivi Then
         '...poistutaan aliohjelmasta
         Exit Sub
      End If

      ' oletetaan, että koontitauluun tuotavan
      ' datan ensimmäinen rivi on rivi 5
      koontiEkarivi = 5

      ' poimitaan koontitaulun käytössä olevan alueen
      ' viimeisen rivin indeksi muuttujaan koontiRivit
      koontiRivit = Sheets("KOONTI").UsedRange.Rows.Count

      ' jos muuttujan koontiRivit arvo on suurempi
      ' tai yhtäsuuri, kuin oletus rivi 5 niin valitaan
      ' alue riviltä 5 riville koontiRivit ensimmäisestä
      ' viimeiseen sarakkeeseen ja tyhjennetään alue
      If koontiRivit >= koontiEkarivi Then
         Sheets("KOONTI").Range( _
         Sheets("KOONTI").Cells(koontiEkarivi, 1), _
         Sheets("KOONTI").Cells(koontiRivit, _
         Sheets("KOONTI").Columns.Count)).Select
         Selection.Clear
      End If

      ' asetetaan rivilaskurin lähtöarvoksi
      ' muuttujan koontiEkarivi arvo
      rivilaskuri = koontiEkarivi

      'jos listan valinta on suurempi, kuin nolla niin...
      If ListBox1.ListIndex > 0 Then

         For i = dataEkarivi To dataRivit + dataEkarivi
         ' (voit poistaa kaikki: + dataEkarivi
         ' jos datataulun esimmäisen rivin
         ' jossain solussa on jokin arvo)

            ' oletetaan että kuukausi on numerona
            ' datataulun sarkeessa 2:ksi
            If Sheets("DATA").Cells(i, 2) = _
            Sheets("KOONTI").ListBox1.ListIndex Then
               ' kopioidaan datataulusta alue:
               ' riviltä i sarakkeista 1 - 10
               ' koontitauluun alueelle:
               ' rivilaskuri sarakeisiin 1 - 10

               Sheets("DATA").Range(Sheets( _
               "DATA").Cells(i, 1),  Sheets("DATA"). _
               Cells(i, dataSarakkeet)).Copy _
               Destination:=Sheets("KOONTI"). _
               Range(Sheets("KOONTI").Cells( _
               rivilaskuri, 1), Sheets("KOONTI"). _
               Cells(rivilaskuri, dataSarakkeet))
               ' kasvatetaan laskurin arvoa yhdellä
               ' (seuraavaa mahdollista osumaa varten)
               rivilaskuri = rivilaskuri + 1
            End If

         Next i

      ' muutoin...
      Else
         ' valitaan datataulun koko kopiointialue
         ' ja kopioidaan tiedot koontitauluun..
         Sheets("DATA").Range(Sheets("DATA"). _
         Cells(dataEkarivi, 1), Sheets("DATA"). _
         Cells(dataRivit + dataEkarivi, _
         dataSarakkeet)).Copy Destination:=Sheets( _
         "KOONTI").Range(Sheets("KOONTI"). _
         Cells(koontiEkarivi, 1), Sheets("KOONTI"). _
         Cells(koontiEkarivi + dataRivit, dataSarakkeet))
         ' (voit poistaa kaikki: + dataEkarivi
         ' jos datataulun ensimmäisen rivin
         ' jossain solussa on jokin arvo)

      End If

      Sheets("KOONTI").Cells(1, 1).Select
      CommandButton1.Visible = False

   Application.ScreenUpdating = True

End Sub

Private Sub ListBox1_Change()

   CommandButton1.Visible = True

End Sub