Selection, valeur Min, puis copie autre feuille

Résolu
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   -  
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   -
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 !

A voir également:

7 réponses

Réponse 1 / 7
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
0
Réponse 2 / 7
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   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 !
0
Réponse 3 / 7
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   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
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
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"
0
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   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...
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
"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
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
Voici un exemple de code qui marche :

https://www.cjoint.com/?DEhlluZZC1J
0
Réponse 4 / 7
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   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
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
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...
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   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à !
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
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...
0
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   1
 
Que mettre à la place? ça ne marchait que comme ça donc bon...
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
De quelle type sont tes valeurs à comparer ? Entiers, Décimaux...?
0
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   1
 
Ce sont des valeurs décimales négatives.
0
benol3 Messages postés 570 Date d'inscription   Statut Membre Dernière intervention   87
 
Alors met comme type : double à la place de string
0
Réponse 6 / 7
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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
0
Réponse 7 / 7
padbollevrai Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   1
 
Merci beaucoup !

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

Discussions similaires

Copier un lien instagram
alaurore -
LEFEUVRE -

7 réponses
Retrouver liens copiés sur le téléphone
SAMA -
Peterson -

3 réponses
copie d'un lien dans le navigateur internet
Ulysse Orseau -
diamantnoir -

4 réponses
Problème de restrictions
SuperAmbi -
Pat -

5 réponses
Feuille de score belote
nulleeninfo -
brucine -

7 réponses