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

EXCEL - références dans une sélection de plusieurs plages - VB/VBA/VBS - Programmation

Marsh Posté le 23-08-2008 à 22:57:06    


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
Reply

Marsh Posté le 23-08-2008 à 22:57:06   

Reply

Marsh Posté le 24-08-2008 à 00:27:02    

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.

Reply

Marsh Posté le 24-08-2008 à 00:48:15    

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
Reply

Marsh Posté le 24-08-2008 à 00:59:12    

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

Reply

Marsh Posté le 24-08-2008 à 03:51:32    

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+

Message cité 1 fois

---------------
G57
Reply

Marsh Posté le 24-08-2008 à 11:59:06    

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+


Reply

Marsh Posté le 24-08-2008 à 13:17:18    

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
Reply

Marsh Posté le 24-08-2008 à 13:38:56    

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
  5. Sub Macro1()
  6.     Dim cell As Range
  7.     Dim idcol(1000, 1)
  8.     i = 1
  9.     Range("B2" ).Copy
  10.     For Each cell In selection
  11.     idcol(i, 1) = cell.Column
  12.     i = i + 1
  13.     cell(idcol(i, 1), 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  14.     cell(idcol(i, 1), 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  15.     cell(idcol(i, 1) + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  16.     cell(idcol(i, 1) + 10, 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  17.     Next cell
  18.     Application.CutCopyMode = False
  19.     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
Reply

Marsh Posté le 24-08-2008 à 17:02:47    

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
  17. Sub Boucle(Bloc As Range)
  18. Dim Cellule As Range
  19.   For Each Cellule In Bloc
  20.     If Cellule.Row > k Then
  21.       k = Cellule.Row
  22.       Cellule = Range("C31" )
  23.     End If
  24.   Next
  25. 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
Reply

Marsh Posté le 24-08-2008 à 17:04:43    

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

Reply

Marsh Posté le 24-08-2008 à 17:04:43   

Reply

Marsh Posté le 24-08-2008 à 17:39:23    

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

Reply

Marsh Posté le 24-08-2008 à 17:41:34    

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

Reply

Marsh Posté le 24-08-2008 à 18:37:27    

ç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
Reply

Marsh Posté le 24-08-2008 à 19:20:23    

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
  17. Sub Boucle(Bloc As Range)
  18. Dim Cellule As Range
  19. Range("B2" ).Copy
  20. Bloc.PasteSpecial Paste:=xlFormats
  21.   For Each Cellule In Bloc
  22.     ActiveSheet.Paste Cellule.Offset(10)
  23.     If Cellule.Row > k Then
  24.       k = Cellule.Row
  25.       ActiveSheet.Paste Cellule.Offset(10)
  26.       Cellule = Range("B2" )
  27.     End If
  28.   Next
  29. End Sub


A+

Reply

Marsh Posté le 24-08-2008 à 19:26:53    

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

Reply

Marsh Posté le 24-08-2008 à 20:51:23    

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

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed