Discussion :

[HABILER]

Bonsoir la Communauté,

Pourriez-vous me dire ce qui dans mon code ci-dessous
Le but est que les rangées et colonnes dont le contenu = zero soient supprimées?

Dans le code J'ai un problème avec le if et "Total = Total + Cells(i, j).Value" .
test.xlsmError 1004 application or object defined error.

Quelqu'un pourrait_il m'aider svp

Merci D'avance

Ha

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Dim i As Integer, j As Integer
Dim Total As Double
Dim LastRow As Integer
 
'Determine the last row of data in column A
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
 
'Loop through each row starting from row 4
For i = 4 To LastRow
 
    'Initialize the total for each row
    Total = 0
 
    'Loop through each column in the row
    For j = 1 To Columns.Count
 
        'Add the value of each cell to the total
        Total = Total + Cells(i, j).Value
    Next j
 
    'If the total is equal to zero, suppress the row and the column
    If Total = 0 Then
        Rows(i).EntireRow.Hidden = True
        Columns(j).EntireColumn.Hidden = True
    End If
Next i

[ARTURO83]

Bonjour,

Dans votre code, vous masquez les lignes et colonnes égales à 0 (utilisation de "Hidden"), Alors c'est Suppression ou Masquage ?

Voici 2 solutions suivant ce que vous voulez faire réellement.
-Pour masquer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub MasquageColRng()
    Dim i As Long, LastRow As Long, LastCol As Long
    Application.ScreenUpdating = False
    LastRow = Cells(7, "A").End(xlDown).Row
    LastCol = Cells(7, "A").End(xlToRight).Column
    'Masquage des lignes = 0
    For i = LastRow To 8 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(i, "D"), Cells(i, LastCol))) = 0 Then Rows(i).EntireRow.Hidden = True
    Next i
    'Masquage des colonnes = 0
    For i = LastCol To 4 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(8, i), Cells(LastRow, i))) = 0 Then Columns(i).EntireColumn.Hidden = True
    Next i
End Sub

Pour supprimer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub SuppColRng()
    Dim i As Long, LastRow As Long, LastCol As Long
    Application.ScreenUpdating = False
    LastRow = Cells(7, "A").End(xlDown).Row
    LastCol = Cells(7, "A").End(xlToRight).Column
    'Suppression des lignes = 0
    For i = LastRow To 8 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(i, "D"), Cells(i, LastCol))) = 0 Then Rows(i).EntireRow.Delete
    Next i
    'Suppression des colonnes = 0
    For i = LastCol To 4 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(8, i), Cells(LastRow, i))) = 0 Then Columns(i).EntireColumn.Delete
    Next i
End Sub

Cdlt

[HABILER]

Re bonjour,

Merci pour s-le sérieux coup de pouce. Cela marche de manière impeccable.
Serait-il par la même occasion possible de supprimer les colonnes dont la 1ere ligne esyt intitulée AA, BB .....etc.

J'ai essayé le code ci-dessous mais il y a une boucle apparemment.

Dans le deuxième code j'ai essayé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.WorksheetFunction.Sum(Range(Cells(3, i), Cells(LastRow, i))) = 0 or Cells(1, i) = "AA"

Meci d'avance

Habiler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub DeleteColumnIfFirstRowMatchesArray()
    Dim i As Integer
    Dim deleteValues() As Variant
    deleteValues = Array("AA", "BB", "XX")
 
    For i = 1 To Columns.Count
        If IsInArray(Cells(1, i).Value, deleteValues) Then
            Columns(i).Delete
        End If
    Next i
End Sub
 
Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub SuppColRng()
    Dim i As Long, LastRow As Long, LastCol As Long
    Application.ScreenUpdating = False
    LastRow = Cells(2, 3).End(xlDown).Row
    LastCol = Cells(2, 3).End(xlToRight).Column
    'Suppression des lignes = 0
    For i = LastRow To 2 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(i, "D"), Cells(i, LastCol))) = 0 Then Rows(i).EntireRow.Delete
       Cells(i, "B") = Application.WorksheetFunction.Sum(Range(Cells(i, "D"), Cells(i, LastCol)))
    Next i
    'Suppression des colonnes = 0
    For i = LastCol To 5 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(3, i), Cells(LastRow, i))) = 0 or Cells(1, i) = "AA" Then Columns(i).EntireColumn.Delete
        'Cells(i,"A") = Application.WorksheetFunction.IFNA(INDEX(Portal!D:D;MATCH(D:$D;Portal!B:B;0));"")
    Next i
    Call HighlightMatches
    Call Maj_A_From_Portal
End Sub

[ARTURO83]

Bonjour,

Serait-il par la même occasion possible de supprimer les colonnes dont la 1ere ligne est intitulée AA, BB .....etc.

et votre exemple:

Application.WorksheetFunction.Sum(Range(Cells(3, i), Cells(LastRow, i))) = 0 or Cells(1, i) = "AA"

De ce que je vois en première ligne, il n'y a nulle part des intitulés commençant par AA, BB, êtes-vous sûr qu'il s'agit de la ligne 1?

Cdlt

[Tête de chat]

Re,
Suite à la remarque d'Arturo83 peut-être tout simplement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.WorksheetFunction.Sum(Range(Cells(3, i), Cells(LastRow, i))) = 0 or  i > 26

[HABILER]

Bonsoir la communauté,

AA BB sont eneffet des exemples mais dans l'exemple que j'ai fourni avec ma question il s'agit effectivement de code comme "SU", "HW2".......

En résume suppression des colonne et ligne dont les totaux sont nulsainsi que les colonnes ayant comme titres (1ere ligne) les valeurs "SU", "HW2", "VW2" .....

Bonne soirée

Habiler

[ARTURO83]

Bonjour,

Essayez ceci,à compléter pour toutes les colonnes à supprimer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub SuppColRng()
    Dim i As Long, LastRow As Long, LastCol As Long
    Application.ScreenUpdating = False
    LastRow = Cells(7, "A").End(xlDown).Row
    LastCol = Cells(7, "A").End(xlToRight).Column
    'Suppression des lignes = 0
    For i = LastRow To 8 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(i, "D"), Cells(i, LastCol))) = 0 Then Rows(i).EntireRow.Delete
    Next i
    'Suppression des colonnes = 0
    For i = LastCol To 4 Step -1
        If Application.WorksheetFunction.Sum(Range(Cells(8, i), Cells(LastRow, i))) = 0 Then
            Columns(i).EntireColumn.Delete
        Else 'Suppression des colonnes en fonction de leur titre
            Select Case Celles(5, i) 'Si la première ligne du tableau est la ligne 5, sinon remplacez 5 par le N° de la ligne réel
                Case Is = "SU", "HW2", "VW2" 'Complétez la liste avec les autres colonnes 
                    Columns(i).EntireColumn.Delete
            End Select
        End If
    Next i
End Sub

Cdlt