Recherche d'un champs et récupération de la case adjacente

  • Initiateur de la discussion Initiateur de la discussion donogoo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

D

donogoo

Guest
Bonjour à tous ! 🙂

Je viens sur ce forum parce que j'ai vu que vous aider beaucoup de gens et j'espere que vous pourrez m'aider moi aussi...

Ce que j'aimerai faire c'est chercher un champs comme par exemple "Date de création", récupérer la valeur de la case d'a coté (correspondant à l'information recherchée) et envoyer cette valeur vers une case définie.

Exemple:

ETAT INITIAL:

Entreprise Nestlé
Date de création 1956
Effectif à l'adresse 1500
Effectif entreprise 3280

ETAT FINAL SOUHAITE:

Entreprise///Date de création///Effectif entreprise
Nestlé ///1956////3280


Comment pourrais je coder cela en VBA? Il s'agit en fait d'une sorte de copier, coller-transposer sauf que je veux choisir les champs que je déplace.

Merci beaucoup pour votre aide !!! (j'espère que j'ai été clair sur mon pb)

Bonne journée à tous !

Maxime (ou donogoo)
 
Re : Recherche d'un champs et récupération de la case adjacente

Bonjour Donogoo et bienvenue 🙂,
En admettant que tes champs soient sous la forme
A_____________________ B
Entreprise____________ Nestlé
Date de création______ 1956
Effectif à l'adresse__ 1500
Effectif entreprise___ 3280
Entreprise____________ Waters
Date de création______ 1980
Effectif à l'adresse__ 1520
Effectif entreprise___ 2280
En faisant une boucle, tu récupéreras ton fichier traité. Admettons que tu soit en Feuil1 et que tu souhaites le résultat en Feuil2 :
Code:
Sub Transposition()
Dim I As Integer, J As Integer
J = 1
For I = 1 To 5000 Step 4
If Sheets("Feuil1").Cells(I, 1) = "" Then Exit For
With Sheets("Feuil2")
    .Cells(J, 1) = Sheets("Feuil1").Cells(I, 2)
    .Cells(J, 2) = Sheets("Feuil1").Cells(I + 1, 2)
    .Cells(J, 3) = Sheets("Feuil1").Cells(I + 3, 2)
End With
J = J + 1
If Sheets("Feuil1").Cells(I, 1) = "" Then Exit For
Next I
End Sub
A adapter (Step 5 si tu as une ligne blanche entre chaque, etc.).
Bonne journée 😎
 
Re : Recherche d'un champs et récupération de la case adjacente

Merci pour ta réponse si rapide JNP !

Je pense que ton code va bien m'aider. Cela dit, mes données ne sont pas si bien ordonnées (toutes les "entreprises" ne sont pas toutes les 3 lignes) du coup je pensais faire appel à une recherche...

Par exemple, si le champs est entreprise, prendre la case d'a coté et l'envoyer dans Cell(I,2), et sinon, si le champs est "date de la création", prendre la case d'a coté et l'envoyer dans Cell(I,3)... et itérer.


Qu'en penses tu ? Sais tu par hasard quel code cela donnerai ?

Merci d'avance et bonne journée
 
Re : Recherche d'un champs et récupération de la case adjacente

Merci JNP pour ta réponse si rapide !

Je pense qu'elle va bien m'aider !

Cela dit, les champs sur lesquels je travaille ne sont pas si bien ordonnés. Par exemple, les champs "entreprises" ne sont pas toutes les 3 lignes mais parfois 4 ou 6. Du coup, je pensais faire une recherche du style :

Si le champs de la case active est "entreprise", envoyer la valeur de la case d'a coté vers Cell(I,2)
Si le champs de la case active est "effectif à l'adresse", envoyer la valeur de la case d'a coté vers Cell(I,3)
ETC
Sinon, passer à la ligne suivante

et ainsi de suite

Qu'en penses tu ? Aurais tu une idée du code qui permettrai de faire cette opération ?

Merci d'avance et bonne journée

donogoo
 
Re : Recherche d'un champs et récupération de la case adjacente

Merci JNP pour ta réponse si rapide !

Je pense qu'elle va bien m'aider !

Cela dit, les champs sur lesquels je travaille ne sont pas si bien ordonnés. Par exemple, les champs "entreprises" ne sont pas toutes les 3 lignes mais parfois 4 ou 6. Du coup, je pensais faire une recherche du style :

Si le champs de la case active est "entreprise", envoyer la valeur de la case d'a coté vers Cell(I,2)
Si le champs de la case active est "effectif à l'adresse", envoyer la valeur de la case d'a coté vers Cell(I,3)
ETC
Sinon, passer à la ligne suivante

et ainsi de suite

Qu'en penses tu ? Aurais tu une idée du code qui permettrai de faire cette opération ?

Merci d'avance et bonne journée

donogoo
 
Re : Recherche d'un champs et récupération de la case adjacente

Bonjour Donogoo 🙂,
Quelque chose du style
Code:
Sub Transposition()
Dim I As Integer, J As Integer
J = 1
For I = 1 To Sheets("Feuil1").Range("A65536").End(xlUp).Row
If Sheets("Feuil1").Cells(I, 1) = "Entreprise" Then
With Sheets("Feuil2")
    .Cells(J, 1) = Sheets("Feuil1").Cells(I, 2)
    .Cells(J, 2) = Sheets("Feuil1").Cells(I + 1, 2)
    .Cells(J, 3) = Sheets("Feuil1").Cells(I + 3, 2)
End With
J = J + 1
Next I
End Sub
devrait marcher, à condition que le contenu de la cellule soit bien "Entreprise" en respectant les caractères et la casse... Un simple blanc risque de faire échouer le test... Et je ne peux pas mettre de joker car il confondrait "Entreprise" et "Effectif entreprise"...
Par contre, quels types de données sont en trop ? Des lignes blanches, d'autres données ? le plus simple serait de vire toutes les lignes inutiles...
Bonne journée 😎
 
Re : Recherche d'un champs et récupération de la case adjacente

Re Bonjour ! 🙂

En effet, ton code m'a l'air pas mal... pour répondre à ta question de la manière la plus précise possible, je te joins le fichier sur lequel je travaille parce que j'avouerai que j'ai un peu simplifier le problème qui se pose à moi pour l'aborder par étapes...

Tu comprendras mieux en regardant le fichier joint: dans l'onglet Classement, j'ai mis le resultats que j'aimerais (j'ai fait ca a la main pour avoir une idée de comment ca pourrait donner) et dans l'onglet Données brutes, il y a ... les données brutes que j'ai récupérées. Et c'est la que tu va voir que la mise en page est plus que variable...que certaines lignes apparaissent dans une des fiches entreprises mais pas toutes...

D'ou mon idée de faire des recherche de champs.

Je ne suis qu'un débutant en code mais je te montre quand même ce que j'ai écrit qui fonctionne (plus ou moins) mais pas encore pour le resultats espéré.



For i= 1 to N


If ActiveCell.Value Like "Téléphone*" Then

'Telephone
Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 14).Select
ActiveSheet.Paste



'Raison sociale
Range(varValeur).Offset(-5, 0).Select
If ActiveCell.Value = "" Then
Range(varValeur).Offset(-4, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 6).Select
ActiveSheet.Paste
Else
Range(varValeur).Offset(-4, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 6).Select
ActiveSheet.Paste
End If




'Adresse
Range(varValeur).Offset(-3, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 11).Select
ActiveSheet.Paste

'Code postal et ville
Range(varValeur).Offset(-2, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 12).Select
ActiveSheet.Paste


'Pays
Range(varValeur).Offset(-1, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 13).Select
ActiveSheet.Paste
Range(varValeur).Select
End If



If ActiveCell.Value Like "Fax*" Then

'Fax
Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 15).Select
ActiveSheet.Paste
Range(varValeur).Select
End If


If ActiveCell.Value Like "http://*" Then

'Site web
Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 16).Select
ActiveSheet.Paste
Range(varValeur).Select
End If



If ActiveCell.Value Like "CA brut*" Then

Range(varValeur).Offset(0, 1).Select
Selection.Copy
ActiveSheet.Cells(k, 8).Select
ActiveSheet.Paste

Range(varValeur).Select
End If


If ActiveCell.Value Like "NAF*2003" Then

Range(varValeur).Offset(0, 1).Select
Selection.Copy
ActiveSheet.Cells(k, 9).Select
ActiveSheet.Paste

Range(varValeur).Select

End If


If ActiveCell.Value Like "NAF*2008" Then

Range(varValeur).Offset(0, 1).Select
Selection.Copy
ActiveSheet.Cells(k, 10).Select
ActiveSheet.Paste

Range(varValeur).Select

End If



ActiveCell.Offset(1, 0).Select


Next i


Next k

End Sub

Bon, je sais qu'il est pas tres propre ni pro mais rappellons que je balbutie du vb pour l'instant ! et aussi que ce que je veux faire m'a l'air assez compliqué vu le fichier de base qui n'est pas modifiable (vu le nombre d'entreprises sur lesquels je bosses)


Je ne sais pas si tu as le courage de te lancer pour m'aider sur ce problème mais quoi qu'il arrive merci pour tes réponses précédentes !

Et encore bonne journée ! 🙂
 

Pièces jointes

Re : Recherche d'un champs et récupération de la case adjacente

Je mets aussi en lignes les onglets séparément en format texte puisque mon Excel de base est trop lourd...

mais un simple copier coller les remets dans le bon ordre heureusement !

Re Re bonne journée et bon appétit !
 

Pièces jointes

Re : Recherche d'un champs et récupération de la case adjacente

Re 🙂,
T'as pas peur, bonjour l'angoisse 😀...
Faire de l'automatique, j'en doute beaucoup, ne serait-ce que par ce que le nom de l'entreprise est en colonne 1 et non pas en colonne 2 avec Entreprise devant... De plus, ce n'est pas un renseignement par boîte que tu veux, mais chacun des présidents, directeurs, etc...
Eventuellement, ce que je te conseille, c'est de mettre des marqueurs (code couleur dans chaque cellule qui t'intéresse, toutes les entreprises fond jaune) et tu te bases sur la cellule jaune pour faire l'analyse jusqu'à ce que tu retombes sur une cellule jaune. Mais tu vas passer du temps en développant l'usine à gaz pour faire cela... 😛
Je ne suis pas sûr que je pourrai t'aider beaucoup...
Bon courage 😎
 
Re : Recherche d'un champs et récupération de la case adjacente

Oui, je me rend compte que je me suis lancé dans une sacré aventure mais j'y crois !

Je vais y arriver ! Quitte a faire de la pseudo automatisation avec quelques retouches manuelles...


En tout cas merci pour ton aide et bonne après midi
 
Re : Recherche d'un champs et récupération de la case adjacente

YES !!!

Ca yé j'ai réussi à obtenir ce que je voulais !!!

Je te montre le code qd meme ! (meme si il est pas forcément tres esthétique et qu'il est certainement possible de faire plus rapide !)

Sub Macro1()
'
' Touche de raccourci du clavier: Ctrl+e
'
Dim varValeur As String

Dim i As Integer
Dim N As Integer
Dim M As Integer

Dim k As Integer

i = 1
k = 3
N = 6500
' M = 50

'For k = 3 To M

'While Cells(i, 10).Value = ""

For i = 1 To N


'NumLigne = k

'N = 5000

varValeur = ActiveCell.Address

If ActiveCell.Value Like "Téléphone*" Then

'Telephone
Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 14).Select
ActiveSheet.Paste



'Raison sociale
Range(varValeur).Offset(-5, 0).Select

If ActiveCell.Value = "" Then
Range(varValeur).Offset(-4, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 6).Select
ActiveSheet.Paste
Else

Selection.Copy
ActiveSheet.Cells(k, 6).Select
ActiveSheet.Paste
End If




'Adresse
Range(varValeur).Offset(-3, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 11).Select
ActiveSheet.Paste

'Code postal et ville
Range(varValeur).Offset(-2, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 12).Select
ActiveSheet.Paste


'Pays
Range(varValeur).Offset(-1, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 13).Select
ActiveSheet.Paste
Range(varValeur).Select
End If



If ActiveCell.Value Like "Fax*" Then

'Fax
Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 15).Select
ActiveSheet.Paste
Range(varValeur).Select
End If


If ActiveCell.Value Like "http://*" Then

'Site web
Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 16).Select
ActiveSheet.Paste
Range(varValeur).Select
End If



If ActiveCell.Value Like "CA*brut*" Then

Range(varValeur).Offset(0, 1).Select
Selection.Copy
ActiveSheet.Cells(k, 8).Select
ActiveSheet.Paste

Range(varValeur).Select
End If


If ActiveCell.Value Like "NAF*2003" Then

Range(varValeur).Offset(0, 1).Select
Selection.Copy
ActiveSheet.Cells(k, 9).Select
ActiveSheet.Paste

Range(varValeur).Select

End If


If ActiveCell.Value Like "NAF*2008" Then

Range(varValeur).Offset(0, 1).Select
Selection.Copy
ActiveSheet.Cells(k, 10).Select
ActiveSheet.Paste

Range(varValeur).Select

End If


If ActiveCell.Value Like "Président*" Then

Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 7).Select
ActiveSheet.Paste

Range(varValeur).Select

k = k + 1


End If


If ActiveCell.Value Like "Directeur*" Then

Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 7).Select
ActiveSheet.Paste

Range(varValeur).Select

k = k + 1


End If

If ActiveCell.Value Like "Secrétaire*" Then

Range(varValeur).Offset(0, 0).Select
Selection.Copy
ActiveSheet.Cells(k, 7).Select
ActiveSheet.Paste

Range(varValeur).Select

k = k + 1


End If



ActiveCell.Offset(1, 0).Select



Next i


End Sub


Allez, cette fois je te laisse !

Bonne fin d'aprem !
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

C
Réponses
3
Affichages
1 K
claude.dasilva
C
Retour