Selection, valeur Min, puis copie autre feuille

Résolu
padbollevrai Messages postés 58 Statut Membre -  
benol3 Messages postés 718 Statut Membre -
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

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
  2. padbollevrai Messages postés 58 Statut Membre 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
  3. padbollevrai Messages postés 58 Statut Membre 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
    1. benol3 Messages postés 718 Statut Membre 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
    2. padbollevrai Messages postés 58 Statut Membre 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
    3. benol3 Messages postés 718 Statut Membre 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
  4. padbollevrai Messages postés 58 Statut Membre 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
    1. benol3 Messages postés 718 Statut Membre 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

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

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

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

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

7 réponses