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

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : EXCEL - références dans une sélection de plusieurs plages

godric57

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

Publicité

godric57

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.

86vomito33

bonsoir

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

Code :

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range
Dim idcol(1000, 1)
nbval = Target.Count
i = 1
For Each cell In Target
idcol(i, 1) = cell.Column
i = i + 1
Next cell
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

godric57

Merci bcp

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

godric57

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 :

Sub NOM_MACRO(ByVal Sh As Object, ByVal Target As RANGE)
Dim selection As RANGE
Dim idcol(1000, 1)
nbval = Target.Count
i = 1
For Each cell In Target
idcol(i, 1) = cell.Column
i = i + 1
Next cell
RANGE("C31" ).Copy
Cells(i, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Cells(i + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

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

Message cité 1 fois

---------------
G57

86vomito33

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 :

Sub NOM_MACRO(ByVal Sh As Object, ByVal Target As RANGE)
Dim selection As RANGE
Dim idcol(1000, 1)
nbval = Target.Count
i = 1
For Each cell In Target
idcol(i, 1) = cell.Column
i = i + 1
Next cell
RANGE("C31" ).Copy
Cells(idcol(i,1), 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Cells(idcol(i,1) + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

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

godric57

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

godric57

Sinon, voilà ce que ça donne :

Code :

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
nbval = Target.Count
End Sub
Sub Macro1()
Dim cell As Range
Dim idcol(1000, 1)
i = 1
Range("B2" ).Copy
For Each cell In selection
idcol(i, 1) = cell.Column
i = i + 1
cell(idcol(i, 1), 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
cell(idcol(i, 1), 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
cell(idcol(i, 1) + 10, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
cell(idcol(i, 1) + 10, 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next cell
Application.CutCopyMode = False
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

galopin01

bonjour,
Si j'ai bien compris...
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 :

Sub Test()
Dim NbLig%
Dim NbBlocs%
Dim Bloc As Range
NbBlocs = Selection.Areas.Count
If NbBlocs <= 1 Then
If Selection.Rows.Count Then
Boucle Selection
End If
Else
For Each Bloc In Selection.Areas
Boucle Bloc
Next
End If
End Sub
Sub Boucle(Bloc As Range)
Dim Cellule As Range
For Each Cellule In Bloc
If Cellule.Row > k Then
k = Cellule.Row
Cellule = Range("C31" )
End If
Next
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

godric57

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

Publicité

galopin01

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

godric57

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

godric57

ç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

galopin01

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 :

Sub Test()
Dim NbLig%
Dim NbBlocs%
Dim Bloc As Range
NbBlocs = Selection.Areas.Count
If NbBlocs <= 1 Then
If Selection.Rows.Count Then
Boucle Selection
End If
Else
For Each Bloc In Selection.Areas
Boucle Bloc
Next
End If
End Sub
Sub Boucle(Bloc As Range)
Dim Cellule As Range
Range("B2" ).Copy
Bloc.PasteSpecial Paste:=xlFormats
For Each Cellule In Bloc
ActiveSheet.Paste Cellule.Offset(10)
If Cellule.Row > k Then
k = Cellule.Row
ActiveSheet.Paste Cellule.Offset(10)
Cellule = Range("B2" )
End If
Next
End Sub

A+

godric57

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

godric57

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 :

Sub BONTON_1()
Dim target As RANGE
REMPLISSAGE ("C10" )
End Sub
Sub REMPLISSAGE(target)
Dim NbBlocs%
Dim Bloc As RANGE
Dim cell As RANGE
NbBlocs = selection.Areas.Count
Dim idcol(1000, 1)
i = 1
ActiveSheet.Unprotect
selection = ""
RANGE(target).Copy
For Each Bloc In selection.Areas
Bloc.Offset(10).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Bloc.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
For Each cell In Bloc
If cell.Row > k Then
k = cell.Row
cell(1, 1) = RANGE(target)
End If
Next cell
k = 1
Next Bloc
Application.CutCopyMode = False
ActiveSheet.Protect
End Sub
' RAZ
Sub RAZ()
Dim Bloc As RANGE
ActiveSheet.Unprotect
RANGE("J7" ).Copy
For Each Bloc In selection.Areas
Bloc.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Bloc.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Bloc.Offset(10).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next Bloc
Application.CutCopyMode = False
ActiveSheet.Protect
End Sub

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 questions	Tracer 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 Outlook	Requete 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

Page générée en 0.088 secondes