Problème IF/WHILE/FOR

Le 04/12/2016 à 10:53

Bonjour,

J'ai rédigé un code VBA, qui fonctionne a priori sur pour un nombre de données restreint, cependant il ne marche plus quand je passe à un échantillon plus large. J'appuie sur le bouton run mais ne rien se passe. J'aurais aimé savoir si vous aviez des idées de la raison pour laquelle ce pourrait être le cas ?

Code pour échantillon large :

Sub FUNCTIONNEWWW()

Dim Clair As Variant

Dim Cloor As Variant

Dim v As Variant

Dim t As Variant

Dim k As Variant

For i = 3 To 102

Sheets("GF").Activate

If IsEmpty(Cells(i,243)) Then

Do

Sheets("GF").Activate

Sheets(“GF”).Cells(i,244).End(xlToLeft).Select

j = ActiveCell.Column

k=j+1

Sheets("SGMC").Activate

valeur = Application.WorksheetFunction.Max(Range(Sheets("SGMC").Cells(3, k), Sheets("SGMC").Cells(376, k)))

Clair = Application.WorksheetFunction.VLookup(valeur, Range(Cells(3, k), Cells(376, 244)), 244 - k + 1, False)

v = Application.WorksheetFunction.Match(Clair, Range(Cells(3, 244), Cells(376, 244)), 0)

Rows(v + 2).Select

Selection.Delete Shift:=xlUp

Sheets("SGR").Activate

Cloor = Application.WorksheetFunction.VLookup(Clair, Range("IJ3:IJ376"), 1, False)

t = Application.WorksheetFunction.Match(Cloor, Range("IJ3:IJ376"), 0)

Range(Cells(t + 2, k), Cells(t + 2, 244)).Select

Selection.Copy

Sheets("GF").Activate

Cells(i, k).Select

Selection.PasteSpecial

Loop while IsEmpty(Sheets(“GF”).Cells(i, 243))

End if

Next i

End Sub

Je mets en pièces jointes le fichier excel pour l'échantillon restreint.

Globalement il n'y a pas de différente entre les deux hormis le nom des onglets et le nombre de données.

Je mets ci dessous le code (qui est identique au premier) que j'ai utilisé pour cet échantillon restreint.

Sub x()

Dim Clair As Variant

Dim Cloor As Variant

Dim v As Variant

Dim t As Variant

Dim k As Variant

For i = 3 To 12

Sheets("blu").Activate

If IsEmpty(Cells(i, 7)) Then

Do

Sheets("blu").Activate

Cells(i, 7).End(xlToLeft).Select

j = ActiveCell.Column

k = j + 1

Sheets("bla").Activate

valeur = Application.WorksheetFunction.Max(Range(Sheets("bla").Cells(3, k), Sheets("bla").Cells(12, k)))

Clair = Application.WorksheetFunction.VLookup(valeur, Range(Cells(3, k), Cells(12, 8)), 5 - k + 4, False)

v = Application.WorksheetFunction.Match(Clair, Range(Cells(3, 8), Cells(12, 8)), 0)

Rows(v + 2).Select

Selection.Delete Shift:=xlUp

Sheets("blo").Activate

Cloor = Application.WorksheetFunction.VLookup(Clair, Range("H3:H12"), 1, False)

t = Application.WorksheetFunction.Match(Cloor, Range("H3:H12"), 0)

Range(Cells(t + 2, k), Cells(t + 2, 8)).Select

Selection.Copy

Sheets("blu").Activate

Cells(i, k).Select

Selection.PasteSpecial

Loop While IsEmpty(Cells(i, 7))

End If

Next i

End Sub

Merci de votre aide!!!!

17aide-vba-v3.xlsm (25.58 Ko)
Le 04/12/2016 à 14:52

Bonjour Manoushe, bonjour le forum,

Je n'ai ouvert ton fichier que pour voir que les noms des onglets différaient. J'ai refermé aussitôt... Quand tu agis sur plusieurs onglets mieux vaut spécifier que sélectionner. D'ailleurs, en règle générale, il faut toujours éviter les Select inutiles qui ne font que ralentir l'exécution du code.

Ton code modifié sans Select :

Sub FUNCTIONNEWWW()
Dim GF As Worksheet
Dim SGMC As Worksheet
Dim SGR As Worksheet
Dim Clair As Variant
Dim Cloor As Variant
Dim v As Variant
Dim t As Variant
Dim k As Variant

Set GF = Worksheets("GF")
Set SGMC = Worksheets("SGMC")
Set SGR = Worksheets("SGR")

For i = 3 To 102
    If IsEmpty(GF.Cells(i, 243)) Then
        Do
        j = GF.Cells(i, 244).End(xlToLeft).Column
        k = j + 1
        valeur = Application.WorksheetFunction.Max(SGMC.Range(SGMC.Cells(3, k), SGMC.Cells(376, k)))
        Clair = Application.WorksheetFunction.VLookup(valeur, SGMC.Range(SGMC.Cells(3, k), SGMC.Cells(376, 244)), 244 - k + 1, False)
        v = Application.WorksheetFunction.Match(Clair, SGMC.Range(SGMC.Cells(3, 244), SGMC.Cells(376, 244)), 0)
        SGMC.Rows(v + 2).Delete Shift:=xlUp
        Cloor = Application.WorksheetFunction.VLookup(Clair, SGR.Range("IJ3:IJ376"), 1, False)
        t = Application.WorksheetFunction.Match(Cloor, SGR.Range("IJ3:IJ376"), 0)
        SGR.Range(SGR.Cells(t + 2, k), SGR.Cells(t + 2, 244)).Copy
        GF.Cells(i, k).PasteSpecial
    Loop While IsEmpty(GF.Cells(i, 243))
    End If
Next i
End Sub
Le 05/12/2016 à 12:21

Ca ne fonctionne toujours pas, mais merci c'est déjà ça d'amélioré

Le 05/12/2016 à 12:34

Bonjour,

En quoi est-ce du tri ?

Et dans quel ordre ?

Le 05/12/2016 à 13:09

Bonjour,

Ca n'est pas vraiment du tri,

c'est pour insérer les données d'un tableau B (SGR) dans les cellules manquantes d'un tableau A (GF) en fonction de critères s'appliquant sur les colonnes d'un tableau C (SGMC)

Concernant votre question sur l'ordre, je ne la comprends pas bien, désolée !! :/

Le 05/12/2016 à 13:22

Simplement : un tri implique un ordre de tri !

Quant aux critères dont tu signales l'existence, je veux bien croire qu'ils existent mais je serais infoutu d'en déceler le moindre !!

Le 05/12/2016 à 14:05

L'ordre de tri est donné par les "i"

ça commence par i=3 et va jusqu'à 102

en gros: troisième colonne, puis quatrième etc

Les critères c'est là dedans :

Sheets("SGMC").Activate

valeur = Application.WorksheetFunction.Max(Range(Sheets("SGMC").Cells(3, k), Sheets("SGMC").Cells(376, k)))

Clair = Application.WorksheetFunction.VLookup(valeur, Range(Cells(3, k), Cells(376, 244)), 244 - k + 1, False)

v = Application.WorksheetFunction.Match(Clair, Range(Cells(3, 244), Cells(376, 244)), 0)

Rows(v + 2).Select

Selection.Delete Shift:=xlUp

Sheets("SGR").Activate

Cloor = Application.WorksheetFunction.VLookup(Clair, Range("IJ3:IJ376"), 1, False)

t = Application.WorksheetFunction.Match(Cloor, Range("IJ3:IJ376"), 0)

Range(Cells(t + 2, k), Cells(t + 2, 244)).Select

En gros on prend la ligne correspondant à la plus grande valeur dans le tableau onglet SGMC, plus grande valeur de la colonne k, (k étant calculé pour chaque i comme le numéro de colonne de la première colonne vide en partant de la droite dans le tableau onglet GF). et on va chercher les valeur pour cette même ligne dans le tableau de l'onglet SGR

Le 06/12/2016 à 08:58

Heu... !

Là, je me dois de préciser deux choses :

1) Je ne lis pas du code lâché ainsi brouillonnement dans un post. Si je tiens à le lire, je le transfère dans un module, sachant qu'il me faudra le réindenter pour l'avoir sous une forme adéquate...

Mais généralement, si le demandeur se dispense d'utiliser la balise Code (ce qui est un moindre égard pour les intervenants appelés à le lire...), c'est que moi, en contrepartie, je peux me dispenser de le lire !

2) Quand il s'agit de définir des conditions, j'attends qu'elles soient définies en termes littéraux (ou mieux, au moyen d'une table de décision, que tous les cas soient effectivement envisagés...), mais non en me demandant de les extraire de formules ou expressions dont rien ne garantit que ces dernières interprètent correctement et exhaustivement les conditions originaires.

Une fois les conditions clairement énoncées, c'est moi qui définit la formulation ou le code adéquat à les prendre en compte, sans forcément me préoccuper des formulations déjà émises qui, si elles s'étaient avérées totalement fonctionnelles n'auraient pas donné lieu à question.

Ceci dit, ayant deux raisons sur deux de ne pas lire, ne lisant pas, je n'en sais pas plus, mais je n'en aurais peut-être pas su plus en lisant ! autant de gagné Sans incidence sur le sujet, mon intervention n'étant en tout état de cause que très marginale.

Cordialement.

Le 07/12/2016 à 06:02

Etant nouvelle sur ce forum, je ne connais peut être pas tous les codes, et je m'en excuse. Cette balise code notamment. Enfin, je suis cependant ravie de connaître vos conditions de réponses.

Bref, j'ai trouvé une solution à mon problème, sans doute mal exprimé. Du coup si quelqu'un s'est mis en tête de chercher à m'aider, plus besoin, merci beaucoup en tout cas

Rechercher des sujets similaires à "probleme while"