chercher un mot , couper-copier-coller sur une cellule precise (fonction array) ?

[arvin]

bonjour,

voilà soucis de copier - coller : je souhaite chercher un mot dans une plage de cellule et le copier
cette macro est identique à faire pour 31 colonnes
ai utilisé l'enregistreur de macro mais c'est assez long à faire : me demande si la fonction array ne pourrait pas mieux fonctionner ?
pouvez vous m'aider ?
merci beaucoup

 

[st007]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Bonjour
quel intérêt, tu peux développer
faudra d'abord vérifier que la valeur recherché existe dans ta colonne

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Bonsoir arvin, st007,

Du VBA pour ça... C'est le marteau pour écraser une mouche.

Formule en B21 à tirer à droite et vers le bas :

=REPT($A21;SIGNE(NB.SI(B$2:B$11;$A21)))

Fichier joint.

A+

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Bonjour arvin,

Dans vos commentaires vous dites "je coupe".

Alors bien sûr si vous voulez supprimer du tableau source les données transférées il faut du VBA.

Voyez le fichier joint avec ces macros dans le code de la feuille :

Private Sub CommandButton1_Click() 'bouton Transfert
Dim mes As Byte
mes = MsgBox("Le transfert supprimera des données du tableau source." _
    & vbLf & "Voulez-vous mémoriser les données ?", 3, "Mémorisation")
If mes = 2 Then Exit Sub
If mes = 6 Then ThisWorkbook.Names.Add "Memo", [B2:AF11].Value 'nom défini
Transfert [A21:A23], [B2:AF11], [B21:AF23]
End Sub

Private Sub CommandButton2_Click() 'bouton Rétablir
Application.ScreenUpdating = False
If Not IsError([Memo]) Then [B2:AF11] = [Memo]
[B2:AF11].Replace "#N/A", "" 'cellules vides
[B21:AF23].ClearContents 'RAZ zone de destination
End Sub

Sub Transfert(ref As Range, source As Range, destination As Range)
Dim t1, t2, ub&, lig&, col%, i As Variant
t1 = source 'matrice, plus rapide
t2 = destination
ub = UBound(t1, 2)
For lig = 1 To UBound(t1)
  For col = 1 To ub
    i = Application.Match(t1(lig, col), ref, 0)
    If IsNumeric(i) Then
      t2(i, col) = t1(lig, col)
      t1(lig, col) = ""
    End If
  Next
Next
source = t1
destination = t2
End Sub

Bien noter que si l'on veut pouvoir rétablir les données d'origine il faut les avoir mémorisées.

A+

 

[arvin]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

bonjour st007 et job75

ai travaillé une bonne partie de la nuit sur tes réponses job75 et tes résultats sont super !
- pour la formule : elle me convenait parfaitement mais comme tu dis il faut "couper" donc peux t on faire une macro pour effacer les mots sélectionnés dans la partie jaune ? cela serait terrible ! c'est à dire on recherche les noms par la formule , on sauvegarde, et après on efface les noms dans la partie jaune ?
- pour la macro c'est super mais il y a au moins 10 noms à chercher donc une MFC ne fonctionnerait pas je crois si plus de 3 noms
qu'en penses tu ? merci encore de tes recherches

Sinon moi aussi j'ai travaillé avec mes connaissances (et l'enregistreur de macro !) mais cela fonctionne qu'à moitié
tu pourrais regarder ?
un grand merci

bon week end

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Re,

Si l'on utilise VBA il est inutile d'écrire des formules dans la feuille.

La macro que j'ai donnée est très rapide, sur un grand tableau le couper-coller serait très lent.

Quant à votre code, il faut savoir que l'enregistreur de macro est bien utile pour obtenir la bonne syntaxe, mais le code n'est absolument pas optimisé.

Par exemple les Select sont en général inutiles et ne font que ralentir l'exécution.

A+

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Re,

J'oubliais pour la MFC.

Je l'ai mise pour m'amuser mais elle n'est pas indispensable.

A partir d'Excel 2007 il n'y a plus la limitation à 3 conditions qu'il y avait précédemment.

A+

 

[arvin]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

ah ok merci pour les explications
je vais reprendre le fichier "transfert"
je regarde
merci

 

[arvin]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

bonjour,

ai appliqué la macro et c'est super cela fonctionne très rapidement
serait il possible aussi de trier , ce qui reste, aléatoirement par colonne ?
merci

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Bonjour arvin,

Qu'entendez-vous par trier aléatoirement ? Pour moi ça n'a aucun sens

A+

 

[arvin]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Ah oui en fait je voudrais un mélange des noms qui restent dans chaque colonne
Merci job75

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Bonjour arvin, le forum,

Dans le fichier joint j'ai ajouté un bouton avec cette macro :

Sub Tri_aléatoire(r As Range)
Application.ScreenUpdating = False
For Each r In r.Columns
  r.Offset(, 1).Insert xlToRight
  r.Offset(, 1) = "=RAND()" 'fonction ALEA()
  r.Resize(, 2).Sort r.Offset(, 1), Header:=xlNo 'tri
  r.Offset(, 1).Delete xlToLeft
Next
End Sub

A+

 

[arvin]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

bonjour JOB75 et le forum
merci beaucoup c'est exactement cela !
je ne savais pas qu'on pouvait placer la page de cellules entre crochets, c'est vraiment au top - je vais décortiquer la macro !
une demande supplémentaire : 'aurai bien voulu pour chaque colonne, qu'il n'y ait pas de cellules vides : ainsi regrouper les cellules en haut de chaque colonne
je joins le fichier
faut il faire le regroupement (et pas le tri puisque tu m'as mis le bouton macro de tri aléa) avant ou après la fonction alea ?
merci de ta réponse
mais c'est déjà super !

 

[job75]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

Re,

Pour regrouper en haut de colonne, 2ème formule et 2ème tri :

Sub Tri_aléatoire(r As Range)
Application.ScreenUpdating = False
For Each r In r.Columns
  r.Offset(, 1).Insert xlToRight
  r.Offset(, 1) = "=RAND()" 'fonction ALEA()
  r.Resize(, 2).Sort r.Offset(, 1), Header:=xlNo 'tri
  r.Offset(, 1).FormulaR1C1 = "=RC[-1]="""""
  r.Resize(, 2).Sort r.Offset(, 1), xlAscending, Header:=xlNo '2ème tri
  r.Offset(, 1).Delete xlToLeft
Next
End Sub

Fichier (2).

A+

 

[arvin]

Re : chercher un mot , couper-copier-coller sur une cellule precise (fonction array)

excellent c'est super
j'applique ceci ce soir sur mon projet et vous tiens au courant
merci encore