Selection, valeur Min, puis copie autre feuille [Résolu/Fermé]

Signaler
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
-
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
-
Bonjour,

Voici la tâche que je dois effectuer:

Dans une colonne de la feuille INPUT, selectionner les 2 premières valeurs, déterminer la valeur mini, puis la coller dans une colonne de la feuille OUTPUT. Recommencer pour les 2 valeurs suivantes et ainsi de suite !

Voici mon code:


Sub Filling_B()

Dim K As Long
Dim I As Long
Dim Lastline As Integer
Dim Min As Integer
Dim Range As Range

Set shJT = ActiveWorkbook.Sheets("INPUT") 'Aller dans la premiere feuille'

Lastline = Range("A" & Rows.Count).End(xlUp).Row 'Compter le nombre de lignes'

For K = 3 To Lastline Step 2 'faire varier de 3 à la dernière ligne'
Set shJT = ActiveWorkbook.Sheets("INPUT")
Set Range = Worksheets("INPUT").Range("B&k:B&k+1") 'mettre "Bk" et "Bk+1" dans Range'
Min = Application.WorksheetFunction.Min(Range) 'mettre le min de Range dans Min'

Set shJT = ActiveWorkbook.Sheets("OUTPUT") 'Aller dans la deuxième feuille'
For i = 4 to 99999 step 1
Range("C" & i).Select
Selection.Value = Min
Next
Next

End Sub

En premier, il me met une erreur 91 "variable objet ou variable de bloc with non définie" à la ligne ou je veux compter le nombre de lignes. Je ne sais pas pourquoi, mes variables sont déclarées. J'ai une autre macro avec la même synthaxe qui marche au poil !

Bref, je lui fixe arbitrairement une valeur de 1000 pour continuer. Ensuite, ça bloque sur
Set Range = Worksheets("INPUT").Range("B&k:B&k+1")

Effectivement, c'est assez "mal dit", j'ai essayé d'autres synthaxes mais ça me met tout en rouge...


J'ai commencé VBA hier, merci donc de m'éclaircir !

7 réponses

Messages postés
15627
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
6 mars 2021
1 462
Bonjour,

Sub Filling_B()
Dim k As Long
Dim LastlineIn As Integer, LastlineOut As Integer
Dim Mini As Integer
Dim Plage As Range

With Worksheets("INPUT")
Lastline = .Range("A" & Rows.Count).End(xlUp).Row 'Compter le nombre de lignes'
For k = 3 To Lastline Step 2 'faire varier de 3 à la dernière ligne'
Set Plage = .Range("B" & k & ":B" & k + 1) 'mettre "Bk" et "Bk+1" dans Range'
Mini = Application.WorksheetFunction.Min(Plage) 'mettre le min de Range dans Min'
LastlineOut = Worksheets("OUTPUT").Range("C" & Rows.Count).End(xlUp).Row + 1
Worksheets("OUTPUT").Range("C" & LastlineOut) = Mini
Next k
End With

End Sub
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Merci beaucoup !


Mais il y a un problème, il ne se passe rien sur la feuille. Lors du pas-à-pas, le programme passe directement de "For k = 3 to LastLine Step 2" à Next k, et ce sans effectuer les actions entre les deux... "Plage" = Nothing et toutes les valeurs à 0.

Des idées ?

Merci

EDIT: Trouvé, tu avais mis des " LastLine" alors que tu avais déclaré des "LastLineIn". Le programme tourne correctement, en revanche la fonction MIN ne fonctionne pas parce qu'elle me remplit la colonne C avec des zéro... J'avais exactement ce souci de mon coté, je ne sais pas ce qui cloche !
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Re-bonjour,

J'ai pas réussi à utiliser la fonction MIN, donc j'essaie autre chose. Vu que je n'ai que 2 valeurs à chaque fois, je pensais à les comparer pour trouver le Mini.

Voici le code:


Sub Filling_B_bis()
Dim k As Long
Dim LastlineIn As Integer, LastlineOut As Integer
Dim Min As Integer, V1 As String, V2 As String
Dim Plage As Range

With Worksheets("INPUT")
Lastline = .Range("A" & Rows.Count).End(xlUp).Row
For k = 3 To Lastline Step 2
V1 = Range("B" & k).Value
V2 = Range("B" & k + 1).Value
If V1 < V2 Then V1 = Min Else V2 = Min
LastlineOut = Worksheets("OUTPUT").Range("C" & Rows.Count).End(xlUp).Row + 1
Worksheets("OUTPUT").Range("C" & LastlineOut) = Mini
Next k
End With

End Sub


Le programme tourne mais rien ne se passe, Mini reste toujours à 0 et les variables V1 et V2 ne prennent pas les valeurs Bk et Bk+1. V1 est "" et V2 est "0".

Des idées ?

Merci
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
Remplace cette ligne :
If V1 < V2 Then V1 = Min Else V2 = Min

par "If V1 < V2 Then Mini = V1 Else Mini =V2"

Change le type de k par "integer"
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Merci.

J'ai trouvé le problème: Quand la feuille Input de mon classeur est ouverte, les valeurs de V1 et V2 sont correctement entrées, sinon non. Donc le "With Worksheets("Input") ne marche pas.
Aussi, que les valeurs soient prises en compte ou non, rien n'est recopié dans la feuille Output...
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
"Dim Mini As Integer" et non "Dim Min As Integer"
La valeur a affecter est stocker dans mini or mini n'a pas été déclaré...

tu as déclaré V1 et V2 en string pour avoir le minimum, il faut qu'ils soient en integer

fais attention c'est LastlineIn qui a été déclaré et non Lastline donc modife le nom de tes variables
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
Voici un exemple de code qui marche :

https://www.cjoint.com/?DEhlluZZC1J
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Merci Benol, mais les restrictions d'accès de mon entreprise m'empêchent d'ouvrir ce type de liens.

Bon, j'ai enfin un truc qui marche !


Sub Filling_B_bis()

Dim K As Integer
Dim Lastline As Integer
Dim Min As String
Dim V1 As String, V2 As String


Set shJT = ActiveWorkbook.Sheets("INPUT")

Lastline = Range("A" & Rows.Count).End(xlUp).Row

For K = 3 To Lastline Step 2
Set shJT = ActiveWorkbook.Sheets("INPUT")

V1 = Range("B" & K).Value
V2 = Range("B" & K + 1).Value
If V1 < V2 Then Min = V1 Else Min = V2

Set shJT = ActiveWorkbook.Sheets("OUTPUT")
LastlineOut = Worksheets("OUTPUT").Range("C" & Rows.Count).End(xlUp).Row + 1
Worksheets("OUTPUT").Range("C" & LastlineOut) = Min

Next K

End Sub



Par contre, il faut impérativement que je me trouve dans la bonne page du classeur, c'est à dire la page INPUT, pour que les valeurs soient prises.

J'ai mis des ActiveWorkbook.Sheets("INPUT") partout, mais rien n'y fait !
Des idées ?


Merci
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
Fais attention, tu as toujours V1 et V2 en type STRING

Enlève tes "ActiveWorkbook.Sheets("INPUT") " et rajoute juste "sheets("Input").select" juste après ta ligne : for..

Ainsi que "sheets("Output").select" juste avant ta ligne : LastlineOut=...

Ps : ton instruction commence par : "Set shJT =" par conséquent excel interprète shJT comme un objet or il n'est pas déclaré. Je te conseille de rajouter : "option explicit" dasn tous tes modules VBA. Excel va te signale ce genre d'erreurs...
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Effectivement, cette commande est plus efficace.
Ca marche nikel maintenant, meme avec V1 et V1 en String, pourquoi les changer ?

Une remarque: Avec le passage d'une feuille à l'autre, c'est très saccadé et long, j'ai donc ajouté une commande pour désactiver le rafraichissement de l'affichage le temps de l'exécution.


Sub Filling_B_Min()

Dim K As Integer
Dim Lastline As Integer
Dim Min As String
Dim V1 As String, V2 As String
Application.ScreenUpdating = False



Sheets("INPUT").Select

Lastline = Range("A" & Rows.Count).End(xlUp).Row

For K = 3 To Lastline Step 2
Sheets("INPUT").Select

V1 = Range("B" & K).Value
V2 = Range("B" & K + 1).Value
If V1 < V2 Then Min = V1 Else Min = V2

Sheets("OUTPUT").Select
LastlineOut = Worksheets("OUTPUT").Range("C" & Rows.Count).End(xlUp).Row + 1
Worksheets("OUTPUT").Range("C" & LastlineOut) = Min

Next K
Application.ScreenUpdating = True

End Sub


Voilà !
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
Les string sont des chaines de caractères. Ce n'est pas très cohérents de les comparer avec des opérateurs mathématiques surtout si tes valeurs à comparer ne sont que des valeurs numériques...
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Que mettre à la place? ça ne marchait que comme ça donc bon...
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
De quelle type sont tes valeurs à comparer ? Entiers, Décimaux...?
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Ce sont des valeurs décimales négatives.
Messages postés
569
Date d'inscription
lundi 29 juillet 2013
Statut
Membre
Dernière intervention
7 mai 2015
70
Alors met comme type : double à la place de string
Messages postés
16395
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
5 mars 2021
3 145
Bonjour

Essaies ce code rapide
Option Explicit
Option Base 1

Sub filling_B()
Dim LastlineIn As Integer, T_in(), Nbre As Integer, Idx_in As Integer
Dim T_out(), idx_out As Integer

Application.ScreenUpdating = False 'fige le défilement de l'écran
With Sheets("input")
LastlineIn = .Range("B" & Rows.Count).End(xlUp).Row 'Compter le nombre de lignes'
T_in = Application.Transpose(.Range("B3:B" & LastlineIn))
End With

Nbre = UBound(T_in)
If Nbre Mod 2 <> 0 Then Nbre = Nbre - 1 'ajuste au nombre d'éléments pair
'collecte les mini
ReDim T_out(Nbre / 2) 'dimensionne le tableau des mIn
idx_out = 1
For Idx_in = 1 To Nbre Step 2
T_out(idx_out) = T_in(Idx_in)
If T_in(Idx_in) >= T_in(Idx_in + 1) Then T_out(idx_out) = T_in(Idx_in + 1)
idx_out = idx_out + 1
Next
'restitution
With Sheets("output")
.Range("C1:C18000").Clear
With .Range("C1").Resize(UBound(T_out), 1)
.Value = Application.Transpose(T_out)
.Borders.Weight = xlThin
End With
.Activate
End With
End Sub


maquette de W
https://www.cjoint.com/?3EhmEpkfTFT
Messages postés
51
Date d'inscription
mercredi 1 avril 2009
Statut
Membre
Dernière intervention
18 mars 2015
1
Merci beaucoup !

J'ai trouvé un code qui marche mais je garde celui-ci sous le bras pour la suite !