Votre question

copie du texte d'une cellule dans une autre feuille selon plusieurs conditions sur la ligne

Tags :
  • Programme
  • Programmation
Dernière réponse : dans Programmation
8 Mars 2012 22:17:27

Bonjour à tous !

Je met le code de ce que je veux faire : Sur chaque ligne je teste la présence de "X" sur 2 colonnes et copie la valeur d'une autre cellule de cette ligne selon la disposition des "X".
La copie s'effectue dans un autre classeur et sur des colonnes prédéfinies selon la disposition des X..
Je me suis sûrement emmêlé les pinceaux parce que le programme ne fait pas vraiment ce que je veux..., pas tout à fait !!
la copie a l'air bonne mais les conditions pas toutes.. déjà si qqn pouvait m'aider à simplifier les conditions.... ^^

Merci bcp d'avance pour le temps passé à me répondre !

  1. Option Explicit
  2.  
  3. Sub Macro1()
  4. Dim ln_src As Long
  5. Dim col_src As Integer
  6. Dim ln_dst As Integer
  7. Dim col_dst, coltest As Integer
  8. Dim ws_h, ws_p As Worksheet
  9.  
  10.  
  11. Set ws_h = Sheets("Habilitations_par_Profils")
  12. Set ws_p = Sheets("Rôles_par_Profil")
  13.  
  14. ' initialisation en-tête
  15.  
  16. ln_dst = 2
  17. col_dst = 1
  18.  
  19. ' 5 colonnes à traiter
  20. For col_src = 23 To 78 Step 5
  21. For ln_src = 3 To 1000
  22. If LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "" Then
  23. If LCase(ws_h.Cells(ln_src, 13)) = "c" AND LCase(ws_h.Cells(ln_src, 83)) <> "N/A" Then
  24. ws_h.Cells(, 83).Copy ws_p.Cells(ln_dst, col_dst)
  25. ln_dst = ln_dst + 1
  26. End If
  27. ElseIf LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "x" Then
  28. If LCase(ws_h.Cells(ln_src, 13)) = "c" AND LCase(ws_h.Cells(ln_src, 85)) <> "N/A" Then
  29. ws_h.Cells(ln_src, 85).Copy ws_p.Cells(ln_dst, col_dst)
  30. ln_dst = ln_dst + 1
  31. End If
  32. End If
  33.  
  34. Next
  35. col_dst = col_dst + 1
  36. ln_dst = 2
  37. Next
  38.  
  39.  
  40. End Sub

Autres pages sur : copie texte cellule feuille plusieurs conditions ligne

8 Mars 2012 22:22:37

bon c'est encore moi...

en fait en le relisant j'ai appercu qqs fautes.. et ca fonctionne bel et bien mtn...
néanmoins si qqn avait un moyen de rendre le code plus "simple" au niveaux des conditions répétitives.. je suis preneur !!!

  1. Option Explicit
  2.  
  3. Sub Macro1()
  4. Dim val As String
  5. Dim ln_src As Long
  6. Dim col_src As Integer
  7. Dim ln_dst As Integer
  8. Dim col_dst, coltest As Integer
  9. Dim ws_h, ws_p As Worksheet
  10.  
  11.  
  12. Set ws_h = Sheets("Habilitations_par_Profils")
  13. Set ws_p = Sheets("Rôles_par_Profil")
  14.  
  15. ln_dst = 2
  16. col_dst = 1
  17.  
  18. For col_src = 23 To 78 Step 5
  19. For ln_src = 3 To 1000
  20. If LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "" Then
  21. If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 83)) <> "n/a" Then
  22. ws_h.Cells(ln_src, 83).Copy ws_p.Cells(ln_dst, col_dst)
  23. ln_dst = ln_dst + 1
  24. End If
  25. ElseIf LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "x" Then
  26. If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 85)) <> "n/a" Then
  27. ws_h.Cells(ln_src, 85).Copy ws_p.Cells(ln_dst, col_dst)
  28. ln_dst = ln_dst + 1
  29. End If
  30. End If
  31.  
  32. Next
  33. col_dst = col_dst + 1
  34. ln_dst = 2
  35. Next
  36.  
  37.  
  38. End Sub
m
0
l
a c 75 L Programmation
9 Mars 2012 10:08:21

Pour améliorer, tu pourrais:

1) déplacer "ln_dst = 2" entre les deux for et ainsi ne pas avoir besoin de faire l'init avant le premier for.
2) supprimer les if imbriquer en rajoutant les conditions du deuxième if dans le premier.
3) Calculer le nombre de ligne que tu dois réelement traiter, plutôt que de faire arbitrairement une boucle jusqu'à 1000 (la fonction end(xlUp) de l'objet range t'y aidera).

Et pour les yeux des gens qui t'aide sur ce forum, utiliser la baliser CODE=VB au lieu de CODE tout seul :) 

Pour le reste, ben si tu as beaucoup de conditions, c'est normal que les if soient un peu compliqué (et par expérience, faut pas chercher à trop simplifier, après ça devient illisible par autrui).
m
0
l
Contenus similaires
a b L Programmation
9 Mars 2012 13:38:25

Salut :hello: 

Ben voilà, t'as qu'à faire comme drul te le dit.

Moi, ce bout de programme m'a bien amusé.
Voici comment je l'ai maltraité :

Pour commencer, je mets tes tests un au dessus de l'autre :
  1. If LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "" Then If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 83)) <> "n/a" Then ws_h.Cells(ln_src, 83).Copy ws_p.Cells(ln_dst, col_dst): ln_dst = ln_dst + 1 : End If
  2. ElseIf LCase(ws_h.Cells(ln_src, col_src)) = "x" And LCase(ws_h.Cells(ln_src, col_src + 1)) = "x" Then If LCase(ws_h.Cells(ln_src, 13)) = "c" and LCase(ws_h.Cells(ln_src, 85)) <> "n/a" Then ws_h.Cells(ln_src, 85).Copy ws_p.Cells(ln_dst, col_dst): ln_dst = ln_dst + 1 : End If


Je vire les constantes :
  1. "" 83
  2. "x" 85

Ca, faut le paramétrer, le reste il faut le factoriser

  1. For i = 83 To 85 Step 2
  2. If LCase(ws_h.Cells(ln_src, col_src)) = "x" And _
  3. LCase(ws_h.Cells(ln_src, col_src + 1)) = IIf(i = 83, "", "x") And _
  4. LCase(ws_h.Cells(ln_src, 13)) = "c" And _
  5. LCase(ws_h.Cells(ln_src, i)) <> "n/a" Then
  6.  
  7. ws_h.Cells(ln_src, i).Copy ws_p.Cells(ln_dst, col_dst)
  8. ln_dst = ln_dst + 1
  9. Exit For
  10. End If
  11. Next


Bon, à part ça, il y a une petite erreur dans ton code. A la ligne 7. Sauras-tu la trouver ?

---------------------

Mais quelle horreur toutes ces coordonnées que tu te trimballes.
Utilise les objets !

T'as onze blocks de 998 (?) lignes par 5 colonnes.

Alors
  1. Set cell_dest = ws_p.Cells(2, 1) ' A2
  2.  
  3. For k = 0 To 10
  4. For Each row_h In ws_h.Range(ws_h.Cells( 3, k * 5 + 23),
  5. ws_h.Cells(1000, k * 5 + 28)).Rows
  6.  
  7. If LCase(row_h.EnrireRow.Cells(13)) = "c" And _
  8. LCase(row_h.Cells(1) ) = "x" Then
  9.  
  10. For i = 83 To 85 Step 2
  11. If LCase(row_h.Cells(2) ) = IIf(i = 83, "", "x") And _
  12. LCase(row_h.EnrireRow.Cells(i)) <> "n/a" Then
  13.  
  14. row_h.Cells(i).Copy ws_p.Cells(row_dst, col_dst)
  15. Set cell_dest = cell_dest.Offset(1)
  16. Exit For
  17. End If
  18. Next
  19. End If
  20. Set cell_dest = cell_dest.Offset(0, 1).EntireColumn.Cells(2)
  21. Next
  22. Next


:sol: 
m
0
l
a c 75 L Programmation
9 Mars 2012 13:57:29

Citation :
Bon, à part ça, il y a une petite erreur dans ton code. A la ligne 7. Sauras-tu la trouver ?

LOL, j'avais raté celle là.
Le pire c'est qu'il a fait juste à la ligne 5 :lol: 
m
0
l
a b L Programmation
9 Mars 2012 13:58:49

Certes. ;) 
m
0
l
14 Mars 2012 23:56:54

Merci beaucoup à vous 2 pour vos réponses, je regarde tout ca et je modifie mon code.

Je suis aussi en train de plancher sur une façon pour ne faire la copie que si la valeur de la cellule n'existe pas déjà dans la colonne de destination.. je penche pour la fonction RechercheV... je regarde dans ce sens et vous tient au courant.

Merci encore
m
0
l
a c 75 L Programmation
15 Mars 2012 07:21:39

L'operateur "like" peux peut-être t'aider ...
m
0
l