Vérification cellules pleines sur plage de données

Le 29/08/2014 à 12:09

Bonjour à tous,

Excusez le titre, mais difficle de faire plus court.

La question centrale de mon topic est celle ci : existe-t-il un moyen de scanner une plage de données complètes d'une seule traite et ne pas vérifier chaque cellule avec un For Each ? Pour mieux comprendre je vous invite bien sûr à lire la suite. =)

La verson longue de l'explication :

Petit topo sur mon code avant d'expliciter mon besoin.

Celui ci réalise un traitement (copier-coller) depuis 2 fichiers sources vers un fichier synthèse dans certaines conditions.

  • La première condition est d'avoir un numéro affecté sur une case B5 (puis B19, B33 et ainsi de suite - step 14).
  • 2ème condition il regarde chaque cellule d'une plage de données (elle aussi raccordée à une boucle en step 14). Si une cellule de cette plage est vide il réalise le traitement du fichier source n°1 (à savoir fichier BE) puis réalise le traitement du 2ème fichier source (à savoir fichier qualité).

Tout ceci fonctionne à merveille sauf qu'il me manque une dernière chose. Je voudrais que le fichier réalise le traitement du 2ème fichier source (toujours le fichier qualité) si celui ci comporte une case vide dans sa propre plage de données mais que le fichier source n°1 ne comporte que des cases pleines dans sa plage. J'ai tenté quelque chose avec une nouvelle boucle :

For Each Cell in Range blabla

If Cell <> "" Then... Mon traitement du fichier qualité

Voici le code en question : pour moi tout doit se jouer dans le

If o = ""

. Du moins il manque un Else à ce niveau pour envoyer mon scan complet de la plage de donnée du fichier qualité.

Sub Bouton345_Cliquer()

'cacher les bascules pendant le traitement
Application.ScreenUpdating = False

'déclarer les variables
Dim iRC%, iRS% '(iRS = RowSource,iRC = RowCible)
Dim WsS As Worksheet, WsC As Worksheet, WsQ As Worksheet
Dim o As Range, oo As Range, CellCount As Range
Dim flag As Boolean
Dim compteur As Integer

'Ouvrir les fichiers excel
Workbooks.Open ("C:\Users\st_chal\Desktop\Suivi modules G\Suivi_Modules_G_BE.xlsm")
Workbooks.Open ("C:\Users\st_chal\Desktop\Suivi modules G\Suivi_Modules_G_Qualite.xlsm")

Set WsS = Workbooks("Suivi_Modules_G_BE.xlsm").Worksheets("Suivi_BE")
Set WsC = Workbooks("Suivi_Modules_G_Synthese_essai.xlsm").Worksheets("Suivi_Modules")
Set WsQ = Workbooks("Suivi_Modules_G_Qualite.xlsm").Worksheets("Suivi_Qualite")

'Initialisation de la cible
iRC = 4

With WsS

    'pour i allant de 5 à 200 avec un pas de 14 sur fichier BE
    For iRS = 5 To 1000 Step 14

        If .Cells(iRS, 2).Value <> "" Then

            'super condition pour BE : scanner plage de données = si 1 vide entrer dans le traitement
            For Each o In .Range(.Cells(iRS + 7, 2), .Cells(iRS + 11, 6))

                'si case vide pendant le scan de la plage B12 : F16
                If o = "" Then         'On copie toute la plage de données (avec les dates)
                  flag = True

                  .Cells(iRS, 2).Copy
                  WsC.Cells(iRC, 2).PasteSpecial xlPasteAll
                  .Range(.Cells(iRS + 7, 2), .Cells(iRS + 11, 6)).Copy
                  WsC.Range(WsC.Cells(iRC + 8, 3), WsC.Cells(iRC + 12, 7)).PasteSpecial xlPasteAll

                  'copie les dates de prélèvement sur fichier BE
                  .Cells(iRS + 1, 2).Copy
                  WsC.Cells(iRC + 1, 2).PasteSpecial xlPasteAll
                  .Cells(iRS + 2, 2).Copy
                  WsC.Cells(iRC + 2, 2).PasteSpecial xlPasteAll

                    '--------------------------------------------------
                    'Lancer le traitement du fichier qualité
                    '--------------------------------------------------

                    'trouver le n° d'OF côté qualité
                    For iQ = 5 To 1000 Step 14

                        'si n° d'OF trouvé
                        If .Cells(iRS, 2).Value = WsQ.Cells(iQ, 2) Then

                        'Copie les dates de convocation aux APAVE sur fichier QU
                        WsQ.Cells(iQ + 1, 2).Copy
                        WsC.Cells(iRC + 3, 2).PasteSpecial xlPasteAll
                        WsQ.Cells(iQ + 2, 2).Copy
                        WsC.Cells(iRC + 4, 2).PasteSpecial xlPasteAll

                        'Copier la plage de données QU sur synthèse (hors dossier final et cahier de soudage)
                        WsQ.Range(WsQ.Cells(iQ + 7, 3), WsQ.Cells(iQ + 12, 6)).Copy
                        WsC.Range(WsC.Cells(iRC + 8, 8), WsC.Cells(iRC + 12, 11)).PasteSpecial xlPasteAll

                        'copier plage cahier de soudage
                        WsQ.Range(WsQ.Cells(iQ + 7, 2), WsQ.Cells(iQ + 12, 2)).Copy
                        WsC.Range(WsC.Cells(iRC + 8, 2), WsC.Cells(iRC + 12, 2)).PasteSpecial xlPasteAll

                            'Colonne dossier final - Ligne 1 date réal'
                            If IsEmpty(WsQ.Cells(iQ + 7, 7)) Or IsEmpty(WsQ.Cells(iQ + 7, 8)) Or IsEmpty(WsQ.Cells(iQ + 7, 9)) Then

                            WsC.Cells(iRC + 8, 12) = ""

                            Else

                            WsQ.Cells(iQ + 7, 8).Copy
                            WsC.Cells(iRC + 8, 12).PasteSpecial xlPasteAll

                            End If

                            'Colonne dossier final - Ligne 2 date envoi APAVE n°1
                            If IsEmpty(WsQ.Cells(iQ + 8, 7)) Or IsEmpty(WsQ.Cells(iQ + 8, 8)) Or IsEmpty(WsQ.Cells(iQ + 8, 9)) Then

                            WsC.Cells(iRC + 9, 12) = ""

                            Else

                            WsQ.Cells(iQ + 8, 8).Copy
                            WsC.Cells(iRC + 9, 12).PasteSpecial xlPasteAll

                            End If

                            'Colonne dossier final - Ligne 3 date retour APAVE
                            If IsEmpty(WsQ.Cells(iQ + 9, 7)) Or IsEmpty(WsQ.Cells(iQ + 9, 8)) Or IsEmpty(WsQ.Cells(iQ + 9, 9)) Then

                            WsC.Cells(iRC + 10, 12) = ""

                            Else

                            WsQ.Cells(iQ + 9, 8).Copy
                            WsC.Cells(iRC + 10, 12).PasteSpecial xlPasteAll

                            End If

                            'Colonne dossier final - Ligne 4 date envoi APAVE n°2
                            If IsEmpty(WsQ.Cells(iQ + 10, 7)) Or IsEmpty(WsQ.Cells(iQ + 10, 8)) Or IsEmpty(WsQ.Cells(iQ + 10, 9)) Then

                            WsC.Cells(iRC + 11, 12) = ""

                            Else

                            WsQ.Cells(iQ + 10, 8).Copy
                            WsC.Cells(iRC + 11, 12).PasteSpecial xlPasteAll

                            End If

                            'Colonne dossier final - Ligne 5 date soldée
                            If IsEmpty(WsQ.Cells(iQ + 11, 7)) Or IsEmpty(WsQ.Cells(iQ + 11, 8)) Or IsEmpty(WsQ.Cells(iQ + 11, 9)) Then

                            WsC.Cells(iRC + 12, 12) = ""

                            Else

                            WsQ.Cells(iQ + 11, 8).Copy
                            WsC.Cells(iRC + 12, 12).PasteSpecial xlPasteAll

                            End If

                        End If

                    Next iQ

                    '--------------------------------------------------
                    'Fin de traitement du fichier qualité
                    '--------------------------------------------------

                     For Each oo In WsC.Range(WsC.Cells(iRC + 8, 2), WsC.Cells(iRC + 12, 12))

                        'on remplace les vides par NON
                        If oo = "" Then
                        oo = "NON"
                        End If

                     Next oo

                  Exit For

                End If

            Next o

            'on incrémente la ligne cible sur fichier synthèse
            If flag Then iRC = iRC + 14
            flag = False

        End If

    Next iRS

End With

With WsC

compteur = 0

For iCount = 4 To 1000 Step 14

    For Each CellCount In .Range("B" & iCount)

        If CellCount <> "" Then

        compteur = compteur + 1

        End If

    Next CellCount

Next iCount

    'afficher le nombre d'affaires non soldées trouvées
    MsgBox "Nombre d'affaires non soldée trouvée : " & compteur

End With

Workbooks("Suivi_Modules_G_BE.xlsm").Close
Workbooks("Suivi_Modules_G_Qualite.xlsm").Close

Application.CutCopyMode = False

End Sub

Au plaisir de lire vos aides et propositions de solutions qui je l'espère seront aussi efficace que possible.

Merci par avance,

H.

Le 29/08/2014 à 17:27

bonjour

j'ai pas regarder dans le détail ton code mais je pense a un truc je ne sais pas si cela est possible dans ton cas mais.... des fois des idées simple ne me viennent pas tout de suite personnellement .....

il existe sous excel la fonction

nb.vide(plage)

ne pourrais pas tu utiliser une instruction du genre

resultat = Application.WorksheetFunction.CountBlank(plage)

fred

Le 01/09/2014 à 15:13

Bonjour fred,

Merci pour ta très bonne idée ! Ca a l'air de pouvoir fonctionner avec cette fonction, il va simplement me falloir un peu de temps et beaucoup d'essais pour l'adapter.

Merci encore,

Cordialement,

H.

Rechercher des sujets similaires à "verification pleines plage donnees"