macro excel récalcitrante Résolu

Question

Bonjour, 

Je cherche à automatiser une fonction qui fonctionne et à la rendre plus élégante.

J'ai un classeur excel avec un certain nombre de feuilles, toutes nommées selon l'activité qu'elles traitent. Dans une dernière feuille, qui me servira de résumé, je souhaite établir un tableau, à 6 colonnes (une colonne par activité), et dans chaque colonne, je désire avoir une liste de textes. A l'heure actuelle, une fonction =si('activitéA'!L9>2498;'activitéA'!D9;" ") me donne une colonne dans laquelle j'ai le texte de la casse D9 de mon activité A uniquement si ma valeur dépasse le seuil que j'ai fixé à 2498. Sinon, je n'ai rien d'affiché à l'écran, ce qui me donne un grand nombre de cellules ne contenant qu'un espace entre deux cellules contenant du texte. j'aimerai éliminer ces cellules "vierges"

J'ai pensé réaliser une macro, mais je n'ai jamais rencontré vba avant aujorud'hui... Notre confrontation a été houleuse ;-) !

Voila donc ce que j'ai, grâce à des questions posées sur ce forum, réussi à bidouiller, mais quelqu'un pourrait-il me corriger car ça bug svp? Un grand merci d'avance!

Sub riskmajbri()
'
' Si la valeur de la colonne L est supérieur à un seuil, affiche le texte de la colonne D correspondant
' dans une autre feuille, sinon, teste la valeur suivante. le résultat est un tableau de textes sans interligne.
'
   

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
  Sheets("Plan d'action").Activate
  
  ' feuille de destination
  
  Col = "i"                 ' colonne données non vides à tester'
  i = 12
  NumLig = 7          ' 1° N° de la 1er ligne de données .... ? '
  With Sheets("PR1422-Briqueter")     ' feuille source'
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 8 To NbrLig             'n° de la 1ere ligne de données'
  
  While "PR1422-Briqueter"R[2]C[i]<2498,NumLig = NumLig + 1
     "=If('PR1422-Briqueter'!R[2]C[4]>2498,'PR1422-Briqueter'!R[2]C[-4], NumLig = NumLig + 1)"
      NumLig = NumLig + 1
      Sheets("Plan d'action").Cells(NumLig, 1).Insert Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'
    End If
    End While
  Next
  End With

f894009 · Answer

Bonjour,

Si j'ai bien compris ce que vous vouliez, cela devrait convenir.
A adapter pour boucler sur toutes les activites.

Sub riskmajbri()
' Si la valeur de la colonne L est supérieur à un seuil,
' affiche le texte de la colonne D correspondant
' dans une autre feuille, sinon, teste la valeur suivante.
' le résultat est un tableau de textes sans interligne.
'
  Dim Lig As Long
  Dim Col As String
  Dim NbrLig As Long
  Dim NumLig As Long

  Const Val_test = 2498

  'feuille de destination
  Worksheets("Plan d'action").Activate

  Col = "L" ' colonne données non vides à tester'
  With Sheets("PR1422-Briqueter") ' feuille source'
    NumLig = 7 ' 1° N° de la 1er ligne de données .... ? '
    NbrLig = .Cells(65536, Col).End(xlUp).Row
  
    For Lig = 8 To NbrLig   'n° de la 1ere ligne de données'
      'Test cellule < a  constante valeur
      If .Cells(Lig, Col) < Val_test Then
        'copie valeur
        Sheets("Plan d'action").Cells(NumLig, 4) = .Cells(Lig, Col)
        'Incremente ligne
        NumLig = NumLig + 1
      End If
    Next Lig
  End With
End Sub

Bon courage (VBA n'a jamais mordu de personne, a ma connaissance, mais.....)

f894009 · Answer

Bonjour, 

macro pour tous les onglets a tester 

Sub riskmaj() 
' Si la valeur de la colonne L est supérieur à un seuil, 
' affiche le texte de la colonne D correspondant 
' dans une autre feuille, sinon, teste la valeur suivante. 
' le résultat est un tableau de textes sans interligne. 
' 
Dim Lig As Long 
Dim Col As String 
Dim NbrLig As Long 
Dim NumLig As Long 
Dim Nom_Onglet(10) 

Const Nb_Onglet = 6 

Nom_Onglet(0) = "PR1410-Pr de Management" 
Nom_Onglet(1) = "PR1421-Réceptionner et envoyer" 
Nom_Onglet(2) = "PR1422-Briqueter" 
Nom_Onglet(3) = "PR1423-Fondre & Couler" 
Nom_Onglet(4) = "PR1433-Analyser" 
Nom_Onglet(5) = "PR1432-Maintenir" 

Nom_Onglet(6) = "" 
Nom_Onglet(7) = "" 
Nom_Onglet(8) = "" 


Const Val_test = 999 

'feuille de destination 
Worksheets("Plan d'action").Activate 

Col = "L" ' colonne données non vides à tester' 

For Pointeur = 0 To Nb_Onglet 
  With Sheets(Nom_Onglet(Pointeur)) ' feuille source' 
    NumLig = 8 ' 1° N° de la 1er ligne de données ' 
    NbrLig = .Cells(65536, Col).End(xlUp).Row 

    For Lig = 8 To NbrLig 'n° de la 1ere ligne de données jusqu'à la dernière ligne non vide' 
      'Test cellule > à constante valeur 
      If .Cells(Lig, Col) > Val_test Then 
        'copie valeur 
        Sheets("Plan d'action").Cells(NumLig, 2 + Pointeur) = .Cells(Lig, 4) 
        'Incremente ligne 
        NumLig = NumLig + 1 
      End If 
    Next Lig 
  End With 

Next x 

End Sub 

Bon courage

Macro excel récalcitrante

2 réponses

Discussions similaires

Newsletters