[RESOLU] Code VBA pour supprimer lignes et colonnes

[tamatave33]

Bonsoir,

Dans un classeur composé de 2 onglets :

- un onglet Sortie dans lequel on trouve une liste de joueur et les renseignements le concernant.
- un onglet Partenaires​

Chaque joueur qui participe à une sortie indique 1 en face de son nom, dans la colonne H
Chaque joueur est affecté d'un numéro.
A partir d'un bouton de commande dans l'onglet Sortie, je voudrais supprimer les lignes de cet onglet dont la valeur dans les cellules de la colonne H, sont différentes de 1 (c'est à dire supprimer les lignes des joueurs qui ne participent pas à la sortie). Parallèlement à cette suppression je voudrais supprimer les lignes et les colonnes des joueurs absents dans l'onglet "Partenaires".
Dans le fichier joint :
De H6 à H111 : toutes les lignes dont la cellule Hxx est différente de 1 doivent être supprimées.
La suppression de ces lignes doit également supprimer les lignes et les colonnes de l'onglet "Partenaires" correspondant au joueur qui a été supprimé.
Dans cet exemple :
- les lignes (8, 9, 10, 13, 14, 15, 16, 18, 19, 20, 21, 22, 25, 26, ..., 106, 107, 108, 109, 110, 111) sont supprimées
- les lignes (7, 8, 9, 12, 13, 14, 15, 17, 18, 19, 20, 21, 24, 25, ..., 105, 106, 107, 108, 109, 110) de l'onglet "Partenaires" sont supprimées,
- les colonnes (G, H, I, L, M, N, O, .....) de l'onglet "Partenaires" sont supprimées.
Si quelqu'un pouvais me donner la solution cela m'aiderait beaucoup.
Merci.

 

[Lone-wolf]

Bonsoir tamatave

Faut pas racconter n'importe quoi, 1 seul joueur est inscrit dans la liste Partenaires et tu veux supprimer toutes ces lignes???

Et dans l'autre tu dis: dont la valeur dans les cellules de la colonne H, sont différentes de 1.

Bon... je fume un join et je vais me coucher. Bonne nuit

 

[cathodique]

je fume un join

Bonsoir Lone-wolf , j'en ai déjà fumé 2. un fichier avec très peu de données dont la plus part seront virées.

Bonne soirée.

 

[Lone-wolf]

Re Cath, oui mais moi c'était un joint de culasse LOL!

@ tamatave: ton fichier en retour. Dans la feuile Partenaires j'ai créé une liste dérolante, il faudra ce basé sur celle-ci pour supprimer le nom.

 

[tamatave33]

Bonjour Lone-wolf,

Merci pour ton aide cela m'a permis d'avancer dans ma grille de joueurs.
J'ai modifié légèrement ton code pour masquer les lignes plutôt que de les supprimer. Par contre je bute, dans l'onglet Partenaires, pour masquer les colonnes dont les cellules (X, 2) sont différentes de 1 (mes connaissances en VBA sont très limités).
Peux-tu me rendre ce petit service STP.
Merci

 

[cathodique]

Bonjour,

Si j'ai bien compris. Tu veux masquer tous les noms figurant sur la feuille "Sortie" qui n'ont pas en colonne H la valeur 1.

Et aussi masquer les lignes et colonnes où figurent ces mêmes noms (Donc pas la peine de mettre le "1" en ligne et en colonne) sur la feuille "Partenaires".

Essaie ce code

Option Explicit

Public i As Long, col As Long, derlig As Long
Public Const num As Long = 1
Public cel As Range

Sub suppression()
    Dim Nom As String, j As Integer
    Application.ScreenUpdating = False

    With Sheets("Sortie")
        .Cells.EntireRow.Hidden = False 'fait réapparaitre les lignes masquées

        For i = 111 To 6 Step -1
            If .Cells(i, 8).Value <> num Then
                Nom = .Cells(i, 3).Value
                .Rows(i).Hidden = True

                With Sheets("Partenaires")
                .Cells.EntireRow.Hidden = False 'fait réapparaitre les lignes masquées
                .Cells.EntireColumn.Hidden = False  'fait réapparaitre les colonnes masquées
                        For j = 111 To 6 Step -1
                        If .Cells(j, 4).Value = Nom Then .Cells(j, 1).EntireRow.Hidden = True
                    Next j
                
                  For col = 111 To 6 Step -1 'c'est 111 pas 110 (corrigé)
                        If .Cells(4, col).Value = Nom Then .Columns(col).Hidden = True
                    Next col
                End With
            End If
            Next i
    End With
End Sub

Ton fichier en retour, plus la peine de mettre 1 sur feuille Partenaires.

 

[Lone-wolf]

Bonjour tamateve

Bien sûr . Le temps de faire la modification et je le remet en ligne.

EDIT: bonjour Cath

Du même style de la macro de Cath, en PJ.

 

[cathodique]

Salut Lone-wolf, au fait hier soir j'avais fumé 2 "Join" à la limite j'aurai pris des joints toriques

 

[Lone-wolf]

Re Cath

Désolé mais je ne sais pas ce que c'est joints toriques

 

[tamatave33]

Bonjour Cathodique et Lone-wolf,

Merci beaucoup pour votre aide, c'est exactement ce que je voulais.
Très bonne soirée et bonne fin de weekend.

 

[tamatave33]

Bonjour Cathodique, bonjour le forum,

Dans le code que tu as écrit plus haut, pourrais-tu me donner la solution pour faire la recherche des cellules <>1 à la fois sur la colonne 8 et sur la colonne 9. Parce que si j'écrit :

If .(Cells(i, 8), Cells(i, 9)).Value <> num Then

à la place de (lorsque la recherche se faisait sur la colonne 8 uniquement) :
If .Cells(i, 8).Value <> num Then

J'ai un message d'erreur.

Merci

 

[cathodique]

Bonjour,

comme ceci, tu as 2 possibilités:
tu veux masquer ou supprimer avec comme conditions qu'il y est 1 en col8 et en col9 (c-à-d un 1 en même temps)
ou bien
s'il y a un 1 soit en col8 ou en col9

If .Cells(i, 8).value<>num And .Cells(i, 9).Value <> num Then '1ère possibilité 1 dans les colonnes

If .Cells(i, 8).value<>num Or .Cells(i, 9).Value <> num Then   '2ème possibilité 1 dans l'une ou l'autre

 

[tamatave33]

Bonjour cathodique,

Merci pour ta réponse. En fait c'est la première possibilité qui me convient.

Toujours, pour ce projet de joueurs, aurais-tu une solution pour mettre un fond de couleur (vert clair par exemple), pour les joueurs qui ne font que 9 trous (c'est à dire les jours qui ont mis 1 dans la colonne 9 de l'onglet "Sortie"), dans l'onglet "Partenaires".

Merci beaucoup.

 

[cathodique]

Bonsoir,

Fais un test avec ce code

Option Explicit

Public i As Long, col As Long, derlig As Long, k As Long
Public Const num As Long = 1
'Public cel As Range

Sub suppression()
    Dim Nom As String, j As Integer
    Application.ScreenUpdating = False

    Sheets("Sortie").Cells.EntireRow.Hidden = False
    Sheets("Partenaires").Cells.EntireRow.Hidden = False
    Sheets("Partenaires").Cells.EntireColumn.Hidden = False
    Sheets("Partenaires").Rows(4).Interior.Pattern = xlNone
    Sheets("Partenaires").Columns(4).Interior.Pattern = xlNone
  
    With Sheets("Sortie")
        For k = 111 To 6 Step -1
            If .Cells(k, 9).Value = num Then
                Nom = .Cells(k, 3).Value
                Sheets("Partenaires").Cells(k, 4).Interior.Color = 10079487
                Sheets("Partenaires").Cells(4, k).Interior.Color = 10079487
            End If
        Next k

        For i = 111 To 6 Step -1
            If .Cells(i, 8).Value <> num And .Cells(i, 9).Value <> num Then
                Nom = .Cells(i, 3).Value
                .Rows(i).Hidden = True

                With Sheets("Partenaires")
                    For j = 111 To 6 Step -1
                        If .Cells(j, 4).Value = Nom Then .Cells(j, 1).EntireRow.Hidden = True
                    Next j

                    For col = 111 To 6 Step -1
                        If .Cells(4, col).Value = Nom Then .Columns(col).Hidden = True
                    Next col
                End With
            End If


        Next i
    End With
End Sub

 

[tamatave33]

Bonjour cathodique,

C'est super. Merci beaucoup pour ton aide.

Très bonne journée.