Problème de boucle et de Resize

[Calvus]

Bonsoir le forum,

En train de m'arracher les cheveux depuis des heures sur un problème à la c...
Je ne comprends pas où est l'erreur, et en même temps je tourne autour.

J'ai un code qui me permet de vérifier dans une autre feuille si j'ai un solde positif ou non.
La boucle tourne sans problème.

Le hic, c'est quand je veux transférer les données trouvées sur ma feuille. Le tableau généré est alors vide..

Je vous mets le code sans le fichier, je pense que c'est inutile.

Dim occurence As Range, k As Integer
Dim t, t1()
t = Range("A20:A178")
ReDim Preserve t1(1 To UBound(t), 1 To UBound(t))

For k = 20 To UBound(t)
Set occurence = Cells(k, 3)
If k = 54 Then
k = 83
ElseIf k = 117 Then
k = 145
End If
   
    Set stock = Feuil24.Columns(4).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(occurence)  'stock = référence en feuille stock
    If stock Is Nothing Then Exit For
   
    Dim sorties As Range, reserve As Range, quantite As Range, firstAddress As String
    Dim numcomm As Range, numcomm_trouvee As Range
    Set sorties = stock.Offset(, 5)
    Set reserve = stock.Offset(, 3)
    Set quantite = occurence.Offset(, 2)
    Set numcomm = Feuil30.[E8]
    Set numcomm_trouvee = Feuil49.Columns(4).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(numcomm)  'stock = référence en feuille stock
   
        If Not numcomm_trouvee Is Nothing Then
            If occurence = numcomm_trouvee.Offset(, 2) Then   'Si la référence en BL = ref trouvée en stock temp
                If reserve > 0 And reserve >= occurence.Offset(, 2) Then    'Si reserve <> "" et reserve >= quantité en BL
                    If MsgBox(occurence & ", Quantité disponible en réserve, " & quantite & " / " & reserve & " alouer au BL ?", vbYesNo) = vbYes Then 'Modif du 22.11.17
                        Dim i As Single
                        For i = 4 To Feuil49.Cells(Rows.Count, 4).End(xlUp).Row
                            If Feuil49.Cells(i, 4) = numcomm And Feuil49.Cells(i, 6) = occurence And reserve > 0 Then
                            Feuil49.Cells(i, 10) = "x"
                            End If
                        Next i
                        sorties = sorties - occurence.Offset(, 2) '   Sorties en feuille stock = Sorties en feuille stock - la quantité en BL
                        reserve = reserve - occurence.Offset(, 2) '   Reserve = reserve - la quantité en BL
                        If reserve = 0 Then reserve = ""
                        '           numcomm_trouvee.EntireRow.Delete
                    End If
                Else
                    If reserve > 0 Then
                        If MsgBox(occurence & ", Quantité disponible en réserve, " & quantite & " / " & reserve & " alouer au BL ?", vbYesNo) = vbYes Then 'Modif du 22.11.17
                            For i = 4 To Feuil49.Cells(Rows.Count, 4).End(xlUp).Row
                                If Feuil49.Cells(i, 4) = numcomm And Feuil49.Cells(i, 6) = occurence And reserve > 0 And Feuil49.Cells(i, 8) <= occurence.Offset(, 2) Then
                                Feuil49.Cells(i, 10) = "x"
                                End If
                            Next i
                            sorties = sorties - reserve '   Sorties en feuille stock = Sorties en feuille stock - la quantité en RESERVE
                            reserve = reserve - reserve '   Reserve = reserve - la quantité en RESERVE
                            If reserve = 0 Then reserve = ""
                            '           numcomm_trouvee.EntireRow.Delete
                        End If
                    End If
                End If
        Else
                If Not numcomm_trouvee Is Nothing Then
                    firstAddress = numcomm_trouvee.Address
                    Do
                        Set numcomm_trouvee = Feuil49.Columns(4).FindNext(numcomm_trouvee)
                        If reserve > 0 And reserve >= occurence.Offset(, 2) Then    'Si reserve <> "" et reserve >= quantité en BL
                            If MsgBox(occurence & ", Quantité disponible en réserve, " & quantite & " / " & reserve & " alouer au BL ?", vbYesNo) = vbYes Then 'Modif du 22.11.17
                                For i = 4 To Feuil49.Cells(Rows.Count, 4).End(xlUp).Row
                                    If Feuil49.Cells(i, 4) = numcomm And Feuil49.Cells(i, 6) = occurence And reserve > 0 And Feuil49.Cells(i, 8) <= occurence.Offset(, 2) Then
                                    Feuil49.Cells(i, 10) = "x"
                                    End If
                                Next i
                                sorties = sorties - occurence.Offset(, 2) '   Sorties en feuille stock = Sorties en feuille stock - la quantité en BL
                                reserve = reserve - occurence.Offset(, 2) '   Reserve = reserve - la quantité en BL
                                If reserve = 0 Then reserve = ""
                            '           numcomm_trouvee.EntireRow.Delete
                            End If
                        Else
                            If reserve > 0 Then
                                If MsgBox(occurence & ", Quantité disponible en réserve, " & quantite & " / " & reserve & " alouer au BL ?", vbYesNo) = vbYes Then 'Modif du 22.11.17
                                    For i = 4 To Feuil49.Cells(Rows.Count, 4).End(xlUp).Row
                                        If Feuil49.Cells(i, 4) = numcomm And Feuil49.Cells(i, 6) = occurence And reserve > 0 And Feuil49.Cells(i, 8) <= occurence.Offset(, 2) Then
                                        Feuil49.Cells(i, 10) = "x"
                                        End If
                                    Next i
                                    sorties = sorties - reserve '   Sorties en feuille stock = Sorties en feuille stock - la quantité en RESERVE
                                    reserve = reserve - reserve '   Reserve = reserve - la quantité en RESERVE
                                    If reserve = 0 Then reserve = ""
                                End If
                            End If
                        End If
                    Loop While Not numcomm_trouvee Is Nothing And firstAddress = numcomm_trouvee.Address
                End If
        End If
'#####################################################
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
   
        If stock.Offset(, 6) < 1 Or stock.Offset(, 6) < occurence.Offset(, 2) Then t1(k, 1) = "x"       'si stock est inférieur à 1 alors mettre un x en colonne A
   
'#####################################################
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
   
    Else
'        Set stock = Feuil24.Columns(4).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(cel)  'stock = référence en feuille stock
        If stock Is Nothing Then GoTo suite
        If stock.Offset(, 6) < occurence.Offset(, 2) Then t1(k, 1) = "x"       'si stock est inférieur à 1 alors mettre un x en colonne A

    End If
MsgBox t1(k, 1)

Next k
suite:
For i = 1 To 5
MsgBox t1(i, 1)
Next
Range("A20").Resize(UBound(t1), 1) = t1

Le Msgbox avant le Next k affiche bien les différents "x"
Le Msgbox après le Next k affiche bien les différents ""

Le Resize ne fonctionne donc pas...

Merci de m'éclairer.

 

[cp4]

Bonjour,

à tout hasard, retire la parenthèse juste après t1.

Range("A20").Resize(UBound(t1, 1) )= t1

joyeux Noël

 

[Roland_M]

Bonjour tout le monde,

essaies un peu comme ceci, selon le premier indice à 0 ou 1 !?
et report du tableau en lignes et colonnes !?
avec 0> Range("A20").Resize(0, UBound(t1)).Value = t1
avec 1> Range("A20").Resize(1, UBound(t1)).Value = t1

EDIT: salut à toi ChTi160 !
effectivement, il ne précise pas cet cette info importante !
Tableau en Lignes/Colonnes !?
c'est à dire, Range("A20").Resize(Ligne, Colonne).Value = t1

 

[ChTi160]

Bonjour Calvus
Bonjour le Fil (cp4),Le Forum
cp4 ,je pense que :

Range("A20").Resize(UBound(t1), 1) = t1

Veut dire redimensionner de UBound(t1) équivaut à Nombre de Lignes et le ",1" au Nombre de Colonnes de la plage ou l'on doit coller le Tableau .
Mais il est dommage , que nous n'ayons pas un extrait du fichier quelles Lignes significatives qui permettraient de faire tourner la procédure !
Bonne Journée
Bonnes Fêtes de fin d'Année
Amicalement
Jean marie

 

[ChTi160]

Re
quand je lis la procédure , je me demande , comment cela fonctionne
t = Range("A20:A178") 'Plage de 158 lignes
ReDim Preserve t1(1 To UBound(t), 1 To UBound(t)) 'on redimensionne le tableau autant de lignes que de colonnes 1 To UBound(t) pour les deux 'soit l'équivalent du nombre de lignes du tableau t
For k = 20 To UBound(t) 'puis on liste le tableau en commençant a la Lignes 20 à du Tableau (t)
et non a la première Ligne de celui ci soit 1 ou 0 selon "Option Base" Choisie ???
Set occurence = Cells(k, 3) 'premiere Ocurrence donc Lignes 20 de la feuille Source colonne 3
pas moyen de tester la procédure !
Je n'ai peut être pas tout compris ! Lol
Bonne Journée
Amicalement
Jean marie

 

[Roland_M]

re

tout à fait ChTi160 !
je viens de regarder aussi et on y voit bien en ligne avec: t = Range("A20:A178")
mais ensuite . . . comme tu l'expliques, ce n'est pas très clair !?

sur ce je vous quitte, pas le temps de m'attarder, car je dois partir !
bonnes fêtes de fin d'année !

 

[mapomme]

Bonjour Calvus 🙂, à tous,

On peut comparer un programme à un tournevis et les données à traiter à une vis.
Tant qu'on n'a pas de vis, on ne peut pas se prononcer sur le fonctionnement du tournevis.
Dès qu'on a une vis, on peut voir si le tournevis convient ou non (un tournevis cruciforme avec une vis à fente, ça le fait pas) .

Si on n'a que le code, on ne peut guère que chercher les fautes de syntaxe voire un peu plus si le code est court, limpide ou commenté.

Un vrai débogage, selon moi, implique un jeu de test de données (au moins celui qui fait planter dans notre cas) pour utiliser au mieux les outils de déverminage de l'environnement VBE.

Je pense qu'un fichier serait le bienvenu et nécessaire ( suffisant, ça c'est à voir)🙂

sinon, dans la fenêtre espion, que contient t1 avant son transfert sur la feuille ? Combien de ligne ? Combien de colonne ? etc...

 

[Calvus]

Bonjour à tous, Chti🙂, Roland🙂, Mapomme🙂,Cp4,

Merci de vos réponses et joyeux noël à vous !

Grâce à vos remarques, j'ai compris mon erreur !
Ça m'était déjà arrivé en plus..

J'ai corrigé comme suit :
For k = 1 To UBound(t)
Set occurence = Cells(k + 19, 3)

C'est tout. Et maintenant ça fonctionne.

Si vous voulez un fichier tout de même par curiosité, je prendrai le temps de le faire. Faites moi savoir.

Mais je pense de toute façon que je ferai certainement de nouveau appel à vos lumières car j'ai décidé de passer tout le code de mon classeur sous forme de tableau.
En effet, il y a des centaines de lignes de code, sur une dizaine de pages d'environ 1500 lignes chacune, et les procédures For Each sont beaucoup trop longues. Plus d'une minute pour chaque macro, et sachant qu'il y a 3 ou 4 procédures d'affilée.... 5 minutes pour 1 clic ça fait beaucoup !
Alors je pense que je vais vous em... avec mes classeurs exemple 😉

Bonne journée à vous et à bientôt.

 

[ChTi160]

Re
content que tu ais pu avancer !
Pas de problème si tu veux mettre un fichier exemple (sans données confidentielles)
Bonne Journée
Amicalement
Jean ma

 

[Calvus]

Re,

Merci Jean Marie,
40 secondes de gagnées grâce à cette modification, mais.. 60 secondes tout de même, pour un traitement de 23 lignes seulement...
Ce qui pose problème, c'est le passage en calcul automatique à chaque fois, et je ne sais pas comment contourner ce problème.
Je vais certainement prendre mon courage à 2 mains et poster le fichier intégral pour voir comment vous pouvez m'aider à accélérer ces procédures. (sur un nouveau fil)

Bonne journée.

 

[ChTi160]

Re
pas sur d'avoir compris
mais avec
Application.Calculation = xlCalculationManual en tête de procédure
puis remettre en
Application.Calculation = xlCalculationAutomatic
en fin de Procédure
tu dis :

traitement de 23 lignes seulement...

combien de lignes peut il y avoir ?
dans l'attente
Amicalement
Jean marie

 

[Calvus]

Bonsoir Jean Marie, le forum,

Application.Calculation = xlCalculationManual en tête de procédure
puis remettre en
Application.Calculation = xlCalculationAutomatic

C'est ce que je fais. Le problème est ce passage de manuel en automatique justement.
Mon fichier Excel est très gros, et le passage d'un mode à l'autre prend plus d'une seconde. Voire 2.
D'où les 60 secondes pour seulement 23 lignes...
C'est pour cela que j'essaie de tout réécrire pour faire les calculs en "dur" et ré-afficher après.
Mais quelle galère !

combien de lignes peut il y avoir ?

Jusqu'à 150 environ.

A bientôt