Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2155 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  EXCEL - références dans une sélection de plusieurs plages

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

EXCEL - références dans une sélection de plusieurs plages

n°1776594
godric57
Posté le 23-08-2008 à 22:57:06  profilanswer
 


Bonsoir,
Merci de m'aider à régler un problème de débutant :
 
Quand je sélectionne plusieurs plages sur ma feuille excel,
je voudrais que VB calcule le n° de colonne de la 1re cellule de chaque ligne (variable "col" )
 
Mais avec ce que j'ai fait, vb ne garde en mémoire que le n° de colonne de la 1re cellule de la 1re ligne
 
 For Each Row In ActiveCell
        col = ActiveCell.Column
 
Quel terme dois-je employer ?
Merci de vos réponses,
 
 


---------------
G57
mood
Publicité
Posté le 23-08-2008 à 22:57:06  profilanswer
 

n°1776615
godric57
Posté le 24-08-2008 à 00:27:02  profilanswer
 

J'élargis ma question :
De manière générale, comment définir dans VB les références d'une sélection aléatoire ?
 
Mon idée : pouvoir sélectionner plusieurs cellules et/ou plages, puis, avec l'aide de boutons, pouvoir produire des actions dans ces sélections.

n°1776616
86vomito33
Posté le 24-08-2008 à 00:48:15  profilanswer
 

bonsoir
 
vu ke tu es dans excel il faut faire une macro mais pas dans un module mais dans thisworkbook.
 

Code :
  1. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  2. Dim cell As Range
  3. Dim idcol(1000, 1)
  4. nbval = Target.Count
  5. i = 1
  6. For Each cell In Target
  7. idcol(i, 1) = cell.Column
  8. i = i + 1
  9. Next cell
  10. End Sub


 
 
edit:
par contre ca ce lance des que tu selectionne une plage
si je trouve je te tiens o crt


Message édité par 86vomito33 le 24-08-2008 à 00:50:19
n°1776618
godric57
Posté le 24-08-2008 à 00:59:12  profilanswer
 

Merci bcp
 
Je vais essayer de comprendre et de l'adapter
Je te tiens au courant
A+

n°1776625
godric57
Posté le 24-08-2008 à 03:51:32  profilanswer
 

Re..
 
bon, je suis un peu perdu. J'ai fait ma sauce, et j'ai le msg "argument non facultatif". qu'est-ce qu'il manque ?

Code :
  1. Sub NOM_MACRO(ByVal Sh As Object, ByVal Target As RANGE)
  2.     Dim selection As RANGE
  3.     Dim idcol(1000, 1)
  4.     nbval = Target.Count
  5.     i = 1
  6.     For Each cell In Target
  7.     idcol(i, 1) = cell.Column
  8.     i = i + 1
  9.     Next cell
  10.     RANGE("C31" ).Copy
  11.     Cells(i, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  12.     Cells(i + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  13.     Application.CutCopyMode = False
  14.     End Sub


au fait, la ligne 4 sert à quoi ?
je vais me coucher ...
A+


---------------
G57
n°1776658
86vomito33
Posté le 24-08-2008 à 11:59:06  profilanswer
 

godric57 a écrit :

Re..
 
bon, je suis un peu perdu. J'ai fait ma sauce, et j'ai le msg "argument non facultatif". qu'est-ce qu'il manque ?
javais essayé comme ca mais jave pas non plus reussi. je suis pas sur que cela soit faisable
 

Code :
  1. Sub NOM_MACRO(ByVal Sh As Object, ByVal Target As RANGE)
  2.     Dim selection As RANGE
  3.     Dim idcol(1000, 1)
  4.     nbval = Target.Count
  5.     i = 1
  6.     For Each cell In Target
  7.     idcol(i, 1) = cell.Column
  8.     i = i + 1
  9.     Next cell
  10.     RANGE("C31" ).Copy
  11.     Cells(idcol(i,1), 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  12.     Cells(idcol(i,1) + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  13.     Application.CutCopyMode = False
  14.     End Sub


au fait, la ligne 4 sert à quoi ? connaitre le nombre de cellule dans ta selection
je vais me coucher ...
A+


n°1776666
godric57
Posté le 24-08-2008 à 13:17:18  profilanswer
 

Salut, bien dormi ?
Merci de m'avoir encore aidé à avancer, mais je suis débutant et j'ai encore un peu de mal.
J'ai qch qui marche presque comme je veux,
mais comment je fais pour te l'envoyer en fichier zip ?
ça serait + facile


---------------
G57
n°1776671
godric57
Posté le 24-08-2008 à 13:38:56  profilanswer
 

Sinon, voilà ce que ça donne :
 

Code :
  1. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  2.     nbval = Target.Count
  3. End Sub
  4. Sub Macro1()
  5.     Dim cell As Range
  6.     Dim idcol(1000, 1)
  7.     i = 1
  8.     Range("B2" ).Copy
  9.     For Each cell In selection
  10.     idcol(i, 1) = cell.Column
  11.     i = i + 1
  12.     cell(idcol(i, 1), 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  13.     cell(idcol(i, 1), 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  14.     cell(idcol(i, 1) + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  15.     cell(idcol(i, 1) + 10, 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  16.     Next cell
  17.     Application.CutCopyMode = False
  18.     End Sub


 
ce que j'aimerais obtenir, c'est que le collage prévu en ligne 13 se fasse une seule fois par ligne, dans la première cellule sélectionnée


---------------
G57
n°1776711
galopin01
Posté le 24-08-2008 à 17:02:47  profilanswer
 

bonjour,
Si j'ai bien compris...  :D  
C'est un petit peu plus compliqué que ce que tu le supposes. (car une sélection multiple même contigüe, n'est pas considéré comme un range, mais comme plusieurs areas)
Voici ce que j'ai compris :

Code :
  1. Sub Test()
  2. Dim NbLig%
  3. Dim NbBlocs%
  4. Dim Bloc As Range
  5. NbBlocs = Selection.Areas.Count
  6.   If NbBlocs <= 1 Then
  7.     If Selection.Rows.Count Then
  8.       Boucle Selection
  9.     End If
  10.   Else
  11.     For Each Bloc In Selection.Areas
  12.       Boucle Bloc
  13.     Next
  14.   End If
  15. End Sub
  16. Sub Boucle(Bloc As Range)
  17. Dim Cellule As Range
  18.   For Each Cellule In Bloc
  19.     If Cellule.Row > k Then
  20.       k = Cellule.Row
  21.       Cellule = Range("C31" )
  22.     End If
  23.   Next
  24. End Sub


 
On lancera la procédure Test qui appelle la procédure Boucle...
 
A+
 
[Edit] la ligne 11 -inutile- à été supprimée... Boucle récupère un paramètre...


Message édité par galopin01 le 24-08-2008 à 18:38:46
n°1776714
godric57
Posté le 24-08-2008 à 17:04:43  profilanswer
 

Salut,
merci, je vais voir.
Au fait, tu sais comment on fait pour envoyer unfichier dans un msg sur ce forum ?

mood
Publicité
Posté le 24-08-2008 à 17:04:43  profilanswer
 

n°1776732
galopin01
Posté le 24-08-2008 à 17:39:23  profilanswer
 

Re,
Aller ici
Uploder le fichier et nous communiquer le lien.
A+

n°1776734
godric57
Posté le 24-08-2008 à 17:41:34  profilanswer
 

merci, je travaille encore un peu mon projet, puis je te montrerai

n°1776748
godric57
Posté le 24-08-2008 à 18:37:27  profilanswer
 

ça y est, j'ai galéré plusieurs heures dessus, car je suis pas très doué,
mais là, ça marche,  
merci beaucoup galopin01 et 86vomito33
vous m'avez bien aidé !!!
 
ci joint le fichier avec 2 3 commentaires :
 
http://cjoint.com/?iysHLsq0jk
 
A+


---------------
G57
n°1776755
galopin01
Posté le 24-08-2008 à 19:20:23  profilanswer
 

Re...
J'ai modifié la macro source pour éviter de traiter tous les blocs à chaque fois. Il n'est pas utile de réinitialiser k car k est réinitialisé à 0 à chaque appel de proc. Mais évidement comme tu as bricolé ça, évidement tu es obligé de réinitialiser.
Pour reprendre mon code, voici la même chose à la lumière de ton fichier joint.
 

Code :
  1. Sub Test()
  2. Dim NbLig%
  3. Dim NbBlocs%
  4. Dim Bloc As Range
  5. NbBlocs = Selection.Areas.Count
  6.   If NbBlocs <= 1 Then
  7.     If Selection.Rows.Count Then
  8.       Boucle Selection
  9.     End If
  10.   Else
  11.     For Each Bloc In Selection.Areas
  12.       Boucle Bloc
  13.     Next
  14.   End If
  15. End Sub
  16. Sub Boucle(Bloc As Range)
  17. Dim Cellule As Range
  18. Range("B2" ).Copy
  19. Bloc.PasteSpecial Paste:=xlFormats
  20.   For Each Cellule In Bloc
  21.     ActiveSheet.Paste Cellule.Offset(10)
  22.     If Cellule.Row > k Then
  23.       k = Cellule.Row
  24.       ActiveSheet.Paste Cellule.Offset(10)
  25.       Cellule = Range("B2" )
  26.     End If
  27.   Next
  28. End Sub


A+

n°1776758
godric57
Posté le 24-08-2008 à 19:26:53  profilanswer
 

OK, vu : je ne connaissais pas offset,
je crois que ça va bcp m'aider
Merci encore de consacrer du temps pour m'aider
bonne soirée,
G57

n°1776812
godric57
Posté le 24-08-2008 à 20:51:23  profilanswer
 

Re-
ça déroule au poil,
mais en adaptant offset à ma procéduré "bricolée", ça va plus vite car le collage offset n'est pas inclus dans la boucle.
je vois la différence, car le fichier sur lequel je bosse est déjà assez lourd.
Et puis, petit galopin :) : il y avait déjà un pb avec k avant même que je modifie ta proposition ...
Merci en tous cas, car sans toi, je ne serais pas arrivé à grand chose.
A une prochaine fois peut-être ? :hello:  
G57
Pour info, le code final :
(bouton_1 est reproduisible facilement, en faisant tjs référence à remplissage)
 

Code :
  1. Sub BONTON_1()
  2. Dim target As RANGE
  3. REMPLISSAGE ("C10" )
  4. End Sub
  5. Sub REMPLISSAGE(target)
  6.     Dim NbBlocs%
  7.     Dim Bloc As RANGE
  8.     Dim cell As RANGE
  9.     NbBlocs = selection.Areas.Count
  10.     Dim idcol(1000, 1)
  11.     i = 1
  12.     ActiveSheet.Unprotect
  13.     selection = ""
  14.     RANGE(target).Copy
  15.     For Each Bloc In selection.Areas
  16.         Bloc.Offset(10).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  17.         Bloc.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  18.             For Each cell In Bloc
  19.                     If cell.Row > k Then
  20.                        k = cell.Row
  21.                        cell(1, 1) = RANGE(target)
  22.                     End If
  23.             Next cell
  24.         k = 1
  25.     Next Bloc
  26.     Application.CutCopyMode = False
  27.     ActiveSheet.Protect
  28.     End Sub
  29. ' RAZ
  30. Sub RAZ()
  31.     Dim Bloc As RANGE
  32.     ActiveSheet.Unprotect
  33.     RANGE("J7" ).Copy
  34.     For Each Bloc In selection.Areas
  35.         Bloc.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  36.         Bloc.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  37.         Bloc.Offset(10).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  38.     Next Bloc
  39.     Application.CutCopyMode = False
  40.     ActiveSheet.Protect
  41. End Sub


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  EXCEL - références dans une sélection de plusieurs plages

 

Sujets relatifs
PEAR et Excel Writer : changer la couleur d'un onglet[RESOLU] [VBA excel] copier un fichier d'un repertoire a un autre
[BAT/VBS] Plusieurs questionsTracer des graphiques à la chaînes avec Excel/VBA [Résolu]
Update de plusieurs valeurs d'une table[RESOLU] [EXCEL] rechercher un caractere dans un texte
Sélection de données après filtre excel et envoi par OutlookRequete site web à la manière d'excel mais en plus grand
[VBA] [EXCEL] Problème Collage Spécial - Transposée 
Plus de sujets relatifs à : EXCEL - références dans une sélection de plusieurs plages


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR