XL 2016 Comment remplacer For Each xOng pour un choix d'onglets et de colonnes ...

Xplorer · 3 Novembre 2021

Bonjour ! s'il vous plait, dans le principe, auriez-vous une idée de ce qu'il faudrait utiliser comme formules, pour appliquer une boucle non pas à tous les onglets
et colonnes d'un classeur, via "For Each xOng" , mais à certaines colonnes choisies, d'onglets choisis ... par exemple .... feuille 1 et feuille 2, colonnes D, G, H .... ?

Merci !

job75 · 3 Novembre 2021

Bonsoir Xplorer,

Utilisez 2 tableaux :

f = Array("Feuil1", "Feuil2")

col = Array("D", "G", "H")

et faites 2 boucles imbriquées sur les éléments de f et de col.

A+

Xplorer · 3 Novembre 2021

job75 à dit:
Bonsoir Xplorer,

Utilisez 2 tableaux :

f = Array("Feuil1", "Feuil2")

col = Array("D", "G", "H")

et faites 2 boucles imbriquées sur les éléments de f et de col.

A+

merci beaucoup !

Je suis en train de me dire que je me suis peut-être trompé dans ma demande. J'essaye d'analyser et mieux comprendre le code écrit par lolotte 83 qui m'a bien aidé.

C'était peut-être pas "for each" .... For each ici a l'air de faire une recherche dans tout le classeur, pour des onglets s'appelant "Cat1", pour y travailler.

Mais ce qu'il se passe dans Cat1 suppose une analyse de tous les onglets et colonnes : c'est ces onglets ci, et colonnes que je voudrais mieux définir.

dans cette portion de code :

Select Case xOng.Name
Case Is <> "CAT1", "macros"
With Sheets(xOng.Name)

.... je devrais peut-être rajouter Case Is <> "feuille1", "feuille2" .... ou plutôt :
Case is <>
f = Array("Feuil1", "Feuil2")
col = Array("D", "G", "H")

?

Voilà le code dans son ensemble :

Sub TEST_XPLORER()
Dim xTablo()
xPreLig = 10
xDerLig = 200
xCpt = 0
With Sheets("CAT1")
.Range("C7:C100").ClearContents
End With
For Each xOng In ThisWorkbook.Sheets
Select Case xOng.Name
Case Is <> "CAT1", "macros"
With Sheets(xOng.Name)
For F = 1 To 50
For Each xCell In .Range(.Cells(xPreLig, F * 1), .Cells(xDerLig, F * 1))
If xCell.Offset(0, 1) = 1 Then
xCpt = xCpt + 1
ReDim Preserve xTablo(1 To xCpt)
xTablo(xCpt) = xCell.Value
End If
Next xCell
Next F
End With
End Select
Next xOng
With Sheets("CAT1")
For F = 1 To UBound(xTablo)
.Range("C" & 7 + F) = xTablo(F)
Next F
End With
End Sub

laurent950 · 3 Novembre 2021

Bonsoir,

VB:

Sub TEST_XPLORER()
Dim xTablo()
xPreLig = 10
xDerLig = 200
xCpt = 0
    With Sheets("Feuil1")
        .Range("C7:C100").ClearContents
    End With
    For Each xOng In ThisWorkbook.Sheets
        Select Case xOng.Name
            Case Is <> "Feuil1", "Feuil2"
                With Sheets(xOng.Name)
                Col = Array("D", "G", "H")
                    For F = LBound(Col) To UBound(Col)
                        For Each xCell In .Range(.Cells(xPreLig, .Range(Col(F) & "1").Column), .Cells(xDerLig, .Range(Col(F) & "1").Column))
                            If xCell.Offset(0, 1) = 1 Then
                                xCpt = xCpt + 1
                                ReDim Preserve xTablo(1 To xCpt)
                                xTablo(xCpt) = xCell.Value
                            End If
                        Next xCell
                    Next F
                End With
        End Select
    Next xOng
    With Sheets("Feuil1")
        For F = 1 To UBound(xTablo)
            .Range("C" & 7 + F) = xTablo(F)
        Next F
    End With
End Sub

Xplorer · 3 Novembre 2021

laurent950 à dit:

Bonsoir,

VB:

Sub TEST_XPLORER()
Dim xTablo()
xPreLig = 10
xDerLig = 200
xCpt = 0
    With Sheets("Feuil1")
        .Range("C7:C100").ClearContents
    End With
    For Each xOng In ThisWorkbook.Sheets
        Select Case xOng.Name
            Case Is <> "Feuil1", "Feuil2"
                With Sheets(xOng.Name)
                Col = Array("D", "G", "H")
                    For F = LBound(Col) To UBound(Col)
                        For Each xCell In .Range(.Cells(xPreLig, .Range(Col(F) & "1").Column), .Cells(xDerLig, .Range(Col(F) & "1").Column))
                            If xCell.Offset(0, 1) = 1 Then
                                xCpt = xCpt + 1
                                ReDim Preserve xTablo(1 To xCpt)
                                xTablo(xCpt) = xCell.Value
                            End If
                        Next xCell
                    Next F
                End With
        End Select
    Next xOng
    With Sheets("Feuil1")
        For F = 1 To UBound(xTablo)
            .Range("C" & 7 + F) = xTablo(F)
        Next F
    End With
End Sub

Bonsoir ! merci 🙂

Si je compare :

For Each xOng In ThisWorkbook.Sheets
Select Case xOng.Name
Case Is <> "CAT1", "macros"
With Sheets(xOng.Name)

avec :

For Each xOng In ThisWorkbook.Sheets
Select Case xOng.Name
Case Is <> "Feuil1", "Feuil2"
With Sheets(xOng.Name)
Col = Array("D", "G", "H")
For F = LBound(Col) To UBound(Col)
For Each xCell In .Range(.Cells(xPreLig, .Range(Col(F) & "1").Column), .Cells(xDerLig, .Range(Col(F) & "1").Column))

dans mon cas, "Cat1" et "macros" , remplacées dans votre cas par "Feuil1" et feuil2" , sont justement des onglets que je n'ai pas besoin de mieux définir, c'est tous les autres onglets qui sont analysés et repris dans "Cat1" que je dois mieux cerner.
Difficile à expliquer

job75 · 4 Novembre 2021

Bonjour Xplorer, laurent950,

Pour ne pas traiter les feuilles listées dans le tableau f :

VB:

Dim f, col, w As Worksheet
f = Array("Feuil1", "Feuil2") 'à adapter
col = Array("D", "G", "H")
For Each w In Worksheets
    If IsError(Application.Match(w.Name, f, 0)) Then
        'suite du code
    End If
Next w

A+

Xplorer · 4 Novembre 2021

job75 à dit:
Bonjour Xplorer, laurent950,

Pour ne pas traiter les feuilles listées dans le tableau f :

VB:

Dim f, col, w As Worksheet f = Array("Feuil1", "Feuil2") 'à adapter col = Array("D", "G", "H") For Each w In Worksheets If IsError(Application.Match(w.Name, f, 0)) Then 'suite du code End If Next w

A+

Bonjour ! Merci beaucoup Laurent.

Ca signifie que ça exclue les feuilles 1 et 2, leurs colonnes D,G,H, pour ne travailler uniquement sur le reste ?

J'ai essayé d'inclure votre code dans celui que j'ai, mais je dois mal m'y prendre, ça ne fonctionne pas encore :

VB:

Sub TEST_XPLORER()
Dim f, col, w As Worksheet
f = Array("TEMPS 1", "TEMPS 2")                                  'à adapter
col = Array("E", "F")
For Each w In Worksheets
    If IsError(Application.Match(w.Name, f, 0)) Then
                                                                       'suite du code
    End If
Next w
    Dim xTablo()
    xPreLig = 10                         'Première ligne à tester
    xDerLig = 200                        'Dernière ligne à tester
    xCpt = 0                            'Compteur à zéro (utile pour le tableau virtuel)
    With Sheets("CAT1")                                                                       'On travaille sur l'onglet REPERTOIRE
        .Range("C7:C100").ClearContents                                                             'On efface les anciennes données (Ici C5:C100)
    End With
    For Each xOng In ThisWorkbook.Sheets                                                            'On boucle sur tous les onglets du classeur
        Select Case xOng.Name                                                                       'On récupère le nom de chaque onglet
            Case Is <> "CAT1", "macros"                                                        'Si Nom<>Répertoire ou Nom<>Liste
                With Sheets(xOng.Name)                                                              'On travaille dans l'onglet
                    For f = 1 To 50                                                                  'On boucle 2x (Car 2 tableaux)
                        For Each xCell In .Range(.Cells(xPreLig, f * 1), .Cells(xDerLig, f * 1))    'On boucle le tableau
                            If xCell.Offset(0, 1) = 1 Then                                          'Si la cellule de droite=1
                                xCpt = xCpt + 1                                                     'On rajoute 1 au compteur
                                ReDim Preserve xTablo(1 To xCpt)                                    'On redimentionne le tableau virtuel incrémenté du compteur
                                xTablo(xCpt) = xCell.Value                                          'On inscrit la valeur d ela cellule dans un tableau virtuel
                            End If                                                                  'Fin Si
                        Next xCell                                                                  'Fin Boucle
                    Next f                                                                          'Fin Boucle
                End With                                                                            'Fin travail sur l'onglet
        End Select
    Next xOng                                                                                       'Fin Boucle
    With Sheets("CAT1")                                                                             'On travaille sur l'onglet REPERTOIRE
        For f = 1 To UBound(xTablo)                                                                 'On boucle sur toutes les valeurs du tableau virtuel
            .Range("C" & 7 + f) = xTablo(f)                                                         'On inscrit a/c de la cellule C7 le résultat du tableau virtuel
        Next f                                                                                      'Fi boucle
    End With                                                                                        'Fin travail sur l'onglet
End Sub

job75 · 4 Novembre 2021

Je ne commente pas, c'est vraiment trop gros 🙄

Mais laurent950 va sûrement se faire un plaisir d'intervenir 🙂

Xplorer · 4 Novembre 2021

job75 à dit:
Je ne commente pas, c'est vraiment trop gros 🙄

Mais laurent950 va sûrement se faire un plaisir d'intervenir 🙂

C'est très gros en effet, et pas à ma porté ... Mais ça me force à plonger dedans et l'aide que vous m'apportez me fait comprendre petit à petit comment ça marche tout ça. Mais tout seul je n'y arriverais évidemment pas.

XL 2016 Comment remplacer For Each xOng pour un choix d'onglets et de colonnes ...

Xplorer

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Xplorer

XLDnaute Nouveau

laurent950

XLDnaute Barbatruc

Xplorer

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Xplorer

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Xplorer

XLDnaute Nouveau

Discussions similaires

XL 2016 Comment remplacer For Each xOng pour un choix d'onglets et de colonnes ...

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency