Új hozzászólás Aktív témák

• #36269 Delila_1 Topikgazda föccer #36267

  Új Válasz 2017-10-10 09:12:16 #36269

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  Topikgazda

  válasz föccer #36267 üzenetére

  A Kr1:Kr4 (kritériumok) változóknál a helyfoglalásnál nem állítottam be a típust (string, double, boolean, date, stb. lehet)

  Az adatokat tartalmazó listát táblázattá alakítottam, a neve Adatok.

  Sub Szures()
Dim Kr1, Kr2, Kr3, Kr4

Kr1 = Range("L1"): Kr2 = Range("L2"): Kr3 = Range("L3"): Kr4 = Range("L4")
' Inputboxban is bekérheted a szűrő feltételeket

ActiveSheet.Range("Adatok").AutoFilter Field:=1, Criteria1:=Kr1 'A oszlop szűrése
ActiveSheet.Range("Adatok").AutoFilter Field:=3, Criteria1:=Kr2 'C oszlop szűrése
ActiveSheet.Range("Adatok").AutoFilter Field:=5, Criteria1:=Kr3 'E oszlop szűrése
ActiveSheet.Range("Adatok").AutoFilter Field:=6, Criteria1:=Kr4 'F oszlop szűrése
End Sub

  Sub Szuro_Reset()
ActiveSheet.Range("Adatok").AutoFilter Field:=1
ActiveSheet.Range("Adatok").AutoFilter Field:=3
ActiveSheet.Range("Adatok").AutoFilter Field:=5
ActiveSheet.Range("Adatok").AutoFilter Field:=6
' Az ActiveSheet.ShowAllData utasításnál minden adat látszik, de
' a szűrő feltételek megmaradnak. Ekkor a sorazonosítók kék színűek
End Sub

  Sub Szurt_Oszlop_Masolasa()
Sheets("Munka2").Columns(1).ClearContents 'előző másolat törlése
Range("B1:B" & Range("B1").End(xlDown).Row).Copy Sheets("Munka2").Range("A1")
End Sub

  Sub Rejtett_e()
If Rows(7).Hidden = True Then
MsgBox "Rejtett"
Else
MsgBox "Ne rejtett"
End If
End Sub

  Sub Szuro_ki_bekapcs()
Range("A1").Select
ActiveCell.CurrentRegion.AutoFilter
End Sub

  [ Szerkesztve ]

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

• #36270 0P1 aktív tag föccer #36267

  Új Válasz 2017-10-10 09:30:12 #36270

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  0P1

  aktív tag

  válasz föccer #36267 üzenetére

  Erre érdemesebb Get&Transformot használni, azt pont ilyenek automatizálására találták ki. És ez annyira egyszerű feladat, hogy scriptelni se kell, csak pár egérkattintás az egész.
  Olvasd be a táblát (Data/Get&Transform/From Table), állttsd be a négy szűrést a négy oszlopban (ugyanúgy műxik, mint a régi autoszűrő funkció, válaszd ki a két oszlopot, amiket át akarsz másolni (Manage Columns/Choose Columns) aztán Close&Load. Ennyi.

Új hozzászólás Aktív témák