Astuces Excel
  1. Astuces Excel
  3. Masquer les lignes si la cellule contient une colonne contenant un certain text ou l'autofiltrage d'un champ unique avec 4 critères
Intereting Posts
VB script excel.exe terminaison du process Utilisation de POI, JAVA et MySQL pour comstackr un document Excel Comment supprimer une feuille de calcul Excel par programme VB.NET Excel: Créez des lignes uniques pour datatables échantillonnées dans le time Supprimer une ligne unique de csv J'ai besoin de countr le nombre de lignes qui ont une valeur dans chacune des deux colonnes Créez une excellente sum en javascript Aidez-moi à find la règle-key qui m'empêche de chanter le niveau de security macro Excel? Validation des données (list) Excel: Couleurs Ajouter un style à Excel dans openxml Excel INDEX MATCH lorsque la valeur peut être dans l'une des 3 colonnes Création de tables pour copyr de Word vers Excel VBA Excel ajoutant une list de validation dynamic Erreur d'exécution "438" avec Border Around Extraction des colonnes de sortie BLAST sous forme CSV avec python

Masquer les lignes si la cellule contient une colonne contenant un certain text ou l'autofiltrage d'un champ unique avec 4 critères

J'ai une feuille avec les colonnes A à M, contenant une table comprenant toutes les lignes et les colonnes. Si, dans la colonne E, une cellule contient la (les) string (s) "Drive", "Inactivity" ou "Halt", je souhaite que la ligne soit cachée. Si, dans la colonne E, une cellule ne contient pas la string "UF_", alors je veux qu'elle soit cachée.

J'ai essayé plusieurs choses et j'ai regardé dans de nombreux endroits. Voici un code que j'ai essayé:

Essayez 1 (passez à la longueur): 

With ActiveSheet loopct = 2 While loopct < count1 DoEvents Application.StatusBar = "Making Table " & loopct txtrmv1 = "Drive" txtrmv2 = "Inactivity" txtrmv3 = "Halt" txtkp = "UF_" celltxt = .Range("E" & loopct).Value If InStr(1, celltxt, txtrmv1, vbTextCompare) Then .Range("E" & loopct).EntireRow.Hidden = True End If If InStr(1, celltxt, txtrmv2, vbTextCompare) Then .Range("E" & loopct).EntireRow.Hidden = True End If If InStr(1, celltxt, txtrmv3, vbTextCompare) Then .Range("E" & loopct).EntireRow.Hidden = True End If If InStr(1, celltxt, txtkp, vbTextCompare) Then .Range("E" & loopct).EntireRow.Hidden = False Else .Range("E" & loopct).EntireRow.Hidden = True End If loopct = loopct + 1 Wend End With

Essayez 2 (exécute mais ne réalise rien): 

 Private Sub HideDrive(ByVal count1 As Long) Dim ws As Worksheet Dim rng As Range, aCell As Range, bCell As Range Set ws = ActiveWorkbook.Sheets("Sheet1") With ws Set rng = .Range("E2:E" & CStr(count1)) Set aCell = rng.Find(What:="Drive", LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=True, SearchFormat:=False) If Not aCell Is Nothing Then Set bCell = aCell Do aCell.EntireRow.Hidden = True Set aCell = rng.FindNext(After:=aCell) Loop While aCell Is Nothing And aCell.Address <> bCell End If End With End Sub

Voici ce que j'utilisais quand je n'avais qu'un seul critère à vérifier (de toute évidence, ma situation a changé): 

 ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= "=*UF_*"

Que puis-je faire pour accomplir ce que je veux? Je n'ai pas pu get un autofilter pour travailler avec plus de deux critères. S'il vous plaît, faites-moi savoir!

Je ne pouvais pas déboguer et exécuter l'autre réponse donnée, alors j'ai continué à travailler et à le résoudre moi-même.

Au lieu d'essayer de cacher chaque mot que je ne voulais pas tous set, je les ai cachés individuellement puis j'ai appelé une fonction de suppression de ligne cachée à chaque fois. 

  ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _ tblnm 'insert if statement here to change filters based upon area ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="=*UF_*" Call RhidRow2(count4) ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="<>*Drive*" Call RhidRow2(count4) ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="<>*Inactivity*" Call RhidRow2(count4) ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="<>*Halt*" Call RhidRow2(count4) ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:="<>#VALUE!" Call RhidRow2(count4)

Voici la suppression cachée de la ligne: 

 Private Sub RhidRow2(ByVal count4 As Long) Dim count1 As Long 'counters to be used Dim ws As Worksheet Dim rngVis As Range Dim rngDel As Range Set ws = ActiveSheet On Error Resume Next Set rngVis = ws.Range("A2:A" & count4).SpecialCells(xlCellTypeVisible) On Error GoTo 0 If rngVis Is Nothing Then ws.Range("Z1").Value = 1 Else For count1 = count4 To 2 Step -1 If ws.Rows(count1).Hidden = True Then If rngDel Is Nothing Then Set rngDel = ws.Rows(count1) Else Set rngDel = Union(rngDel, ws.Rows(count1)) End If End If Next count1 If Not rngDel Is Nothing Then Application.DisplayAlerts = False Intersect(rngDel, rngDel.ListObject.DataBodyRange).Delete 'if row is hidden, delete Application.DisplayAlerts = True End If End If End Sub

Cela fonctionne mieux et plus vite que tout autre chose que j'ai essayé ou a été suggéré.

Vous pouvez vous cacher plusieurs fois. C'est mieux: 

 If InStr(1, celltxt, txtrmv1, vbTextCompare) > 0 Or _ InStr(1, celltxt, txtrmv2, vbTextCompare) > 0 Or _ InStr(1, celltxt, txtrmv3, vbTextCompare) > 0 Or _ InStr(1, celltxt, txtkp, vbTextCompare) = 0 Then .Range("E" & loopct).EntireRow.Hidden = True End If

EDIT: Cela devrait être un excès de vitesse significatif – masque 10 lignes à la fois: (ajouté Next iRow aussi) 

 Option Explicit Dim ws As Worksheet Sub Sub1() Dim iRow&, Count1&, txtrmv1, txtrmv2$, txtrmv3$, txtkp$, celltxt$ Set ws = ActiveWorkbook.Sheets("Sheet1") Count1 = 65000 ' ?? txtrmv1 = "Drive" txtrmv2 = "Inactivity" txtrmv3 = "Halt" txtkp = "UF_" For iRow = 2 To Count1 DoEvents Application.StatusBar = "Making Table " & iRow celltxt = ws.Range("E" & iRow).Value If InStr(1, celltxt, txtrmv1, vbTextCompare) > 0 Or _ InStr(1, celltxt, txtrmv2, vbTextCompare) > 0 Or _ InStr(1, celltxt, txtrmv3, vbTextCompare) > 0 Or _ InStr(1, celltxt, txtkp, vbTextCompare) = 0 Then Call hideSub(iRow) ' End If Next iRow ' thank you, tannmann357 Call hideSub(0) ' flush End Sub Sub hideSub(hideRow&) ' hides 10 rows at a time Static a1&(10), na1& Dim i1&, zRange As Range If hideRow = 0 Then ' finish;end;flush For i1 = 1 To na1 ws.Rows(a1(i1)).Hidden = True Next i1 na1 = 0 Else ' store row in array a1 na1 = na1 + 1 a1(na1) = hideRow If na1 = 10 Then ' hide 10 rows Set zRange = Union( _ Rows(a1(1)), Rows(a1(2)), Rows(a1(3)), Rows(a1(4)), Rows(a1(5)), _ Rows(a1(6)), Rows(a1(7)), Rows(a1(8)), Rows(a1(9)), Rows(a1(10))) 'Debug.Print zRange.Address ' this works but the syntax seems strange -- help me out ws.Range(zRange.Address).Rows.Hidden = True na1 = 0 End If End If End Sub

EDIT: pour mon bénéfice:

replace 

  ' this works but the syntax seems strange -- help me out ws.Range(zRange.Address).Rows.Hidden = True

avec 

  ws.Range(zRange).Rows.Hidden = True