Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeur

[LORDDD]

Bonjour,

voici ma problematique :

Je souhaite effectuer une recherche dans un classeur A (classeur de paramettrage) sur une plage de donnée

et copier le résultat dans un classeur B.

Voir explication + claire ds le fichier.

Je sais le faire en formule classique mais je n'arrive par à la convertir en code vba.

Merci de votre aide
David

 

[joss56]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonjour le forum, Staple et Lorddd,

J'ai proposé récemment ce type d'outil pour l'hôtel dans lequel je bosse . J'ai utilisé, pour ce faire, une base de données multidimensionnelle. Je suis à votre disposition pour vous en dire plus.
Bonne journée,

Jocelyn

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonjour et merci Staple,

Je vais tester cette solution, si j'ai bien suivie ton cheminement, tu crés une base de donner en selectionnant le nom de mes segment BIFR, LIFR etc...

Ensuite dans la formule tu attribus les code de regroupement 1,2,3, etc...

Ca peut le faire, je vais tester, mais je pense qu'il vat me manquer la souplesse de pouvoir changer mon choix de regroupement via l'onglet paramettre. Je teste et je reviens vers toi.

Bonne journée

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Joss56, bienvenue dans la boucle,

Effectivement ton aide m'interresse, en plus on est ds le meme secteur d'activité.
Dslé mais je ne connais pas la base de données multidimensionnelle (suis un peu nul en excel).

Bonne journée

 

[joss56]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Re,

Regarde d'abord la solution de Staple. Il y a 2 façons de voir les choses : la 1ère consiste à utiliser Excel comme base de données et comme outil de restitution pour faire ton reporting. L'autre consiste à décharger Excel de la partie base de données (stockage des données journalières).

A+
Jocelyn

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Hello,

Formule de Staple, est trés sympa, effectivement je vais l'appliquer pour d'autre tableau, ce qui eviter de faire des milliers d'onglets, en plus je connaissait pas le BI?? les point? partique dans mon cas.

Par contre pour mon application actuelle, j'ai vraiment besoin de plus de souplesse dans le déclaratif de mes regroupements.

Dans la meme journée, je peu vouloir regrouper de differente facon, voila pourquoi ce tableau de paramettre qui visualise mes choix


En fait je vais reposter ici mes fichier complet pour vous donner une vision globale de mon projet

 

[joss56]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

As tu les droits pour installer un logiciel?
Comment récupères tu les données quotidiennes (importation logiciel métier)?

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Les données sont exportées de mes PMS soit par fichier Text soit excel.

Ces exportations de donnent par jour et par segment le nombre de chambre en portefeuilles

J'ai déja des programme avec code vba qui ne transforment ces fichiers et les classent pour pouvoir les mettre dans mon classeur DATA 2012.
J'avais travaillé avec le forum en début d'année pour faire cela.

Par contre je n'ai pas le droit d'installer de nouveau logiciel, mais dis moi a quoi tu pense, je suis prenneur de toutes les information, je met en place le poste de RM, et j ai tout a créer.

Bien a toi
David

 

[joss56]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Je pense à jedox (licence free en version community). C'est une base de données multidimensionnelle complètement interfacée Excel qui permet de stocker toutes les données concernant les 4 hôtels. Le reporting, les tableaux de bord se font, quant à eux, sur Excel.
Mais si tu n'as pas l'autorisation d’installer de nouveaux logiciels, je ne vois pas comment mettre une telle solution en œuvre.

Bon après midi,

Jocleyn

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Si tu veux Jocelyn,

J'ai déja ma base de donnée qui se trouve sur mon classeur Data.
Aujourd'hui grace a des formules mon classeur de synthése c'est aller chercher sur un onglet particulier (date de l'extraction) les données), et regrouper mes divers segment en famille.
Par contre une fois que sur mon tableau synthése j'ai ces données (il me faut en moyennes 10 minutes pour tout récuperer), j'effectuer des manipulation qui entrainne de nouveaux calculs.

Je souhaite donc de mon tableau de base de donnée recopier les chiffres de ma base de donnée (segment regroupe par famille), comme ca ces chiffres restent figés (car recopié et non exporté par une formule calcul), et ensuite je peu continuer a travailler.

Pas facile d'expliquer quelque chose que l'on vit au quotidien, pour pouvoir etre aidé lol.

Encore merci de votre patience à tous.

David

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonsoir a vous tous,

Grand pas ce weekend j'ai acheter un bouquin pour avancer avec VBA.

Et j'ai fait mon premier code que voici : (Dslé je sais pas comment vous faite pour le mettre en fond bleu)
Sub Code_seg_parametre()
Dim Cel1 As String 'Segment de départ
Dim Cel2 As String 'Segment paramatre
Dim Cel3 As String 'Résultat code segment
Dim i As Integer 'Compteur de ligne
Dim ii As Integer 'Compteur colone

Range("B3:AB3").ClearContents 'Efface le contenu de la plage a traiter
For ii = 2 To 28 'Boucle ii servant à prendre la valeur du degment de départ
Cel1 = Cells(4, ii)
Cel3 = "NA" 'Valeur NA dans le cas ou pas de correspondance de segment
For i = 8 To 34 'boucle i servant à rechercher la correspondance su segment de départ et comp avec parametre
Cel2 = Cells(i, 32)
If Cel1 = Cel2 Then
Cel3 = Cells(i, 33) 'Récupération du code du segment
End If
Next i
Cells(3, ii) = Cel3 'Copie du code du segment ds le code de ref ou valeur NA
Next ii
End Sub

Je l'ai fait sur un meme classeur et 1 seule feuille, il me faut maintnant l'adapter à mes besoins a savoir 2 classeur et 2 feuilles diferentes.

Qu'en pensez vous les experts, y a t il des choses à rectifier dans l'écriture (ds l'execution c'est exatement ce que je souhaitez), il y a peut etre des choses à améliorer.

Merci par avance pour vos conseils,

Un premier pas vers mon projet en cours!!!!!

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonjour à vous tous,

Quelqu'un pourais me renseigner sur quelques astuce pour mettre en forme mes cellules via VBA, styles centre horizontalement, police, couleur caracteres, gras, etc...

Merci pour votre coup de pouce, à bientôt

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonjour à vous tous,

Voici l'avancement du code, si un expert passe par la il peut me donner sont avis.

Sub Action()
Dim datejour As String 'nom onglet date de depart'
Dim dateref As String 'nom onglet date ref antérieure'
Dim FileName As Variant
Dim ThePath As String
Dim feuil1 As String 'nom du classeur actif
Dim cel1 As String 'Segment de départ
Dim cel2 As String 'segment parametre
Dim cel3 As String 'résultat code segment
Dim i As Integer 'compteur de ligne
Dim ii As Integer 'compteur de ligne

feuil1 = ActiveWorkbook.Name
Sheets("Parametres").Select
datejour = Range("D1")
dateref = Range("D3")

'------------------------------------------------------
'Annulation des filtres de tris'
Sheets("Point Tarifs").Select
Application.Run "'01-Cale Tarifs 2012.xls'!Effacer_tri_filtre"
Sheets("Hotel 1").Select
Application.Run "'01-Cale Tarifs 2012.xls'!Effacer_tri_filtre"
'------------------------------------------------------
'Ouverture du fichier data'
'Selection du classeur sous format xls'
FileName = Application.GetOpenFilename(fileFilter:="xls Files (*.xls), *.xls")
If FileName = False Then Exit Sub
'ouverture du classeur'
ThePath = FileName
Workbooks.Open FileName

FileName = ActiveWorkbook.Name
'------------------------------------------------------
'Position sur 1er date et nettoyage des codes segment
Sheets(datejour).Select
Range("b2:ab2").ClearContents 'nettoyage code hotel 1
Range("ae2:be2").ClearContents 'nettoyage code hotel 2
Range("bh2:ch2").ClearContents 'nettoyage code hotel 3
Range("ck2:dk2").ClearContents 'nettoyage code hotel 4
'Position sur 2eme date et nettoyage des codes segment
Sheets(dateref).Select
Range("b2:ab2").ClearContents 'nettoyage code hotel 1
Range("ae2:be2").ClearContents 'nettoyage code hotel 2
Range("bh2:ch2").ClearContents 'nettoyage code hotel 3
Range("ck2:dk2").ClearContents 'nettoyage code hotel 4
'------------------------------------------------------
'Attribution des codes segments Hotel 1
For ii = 0 To 26
Workbooks(FileName).Activate
Sheets(datejour).Select
cel1 = Cells(3, ii + 2)
cel3 = "NA"
For i = 0 To 26
Workbooks(feuil1).Activate
Sheets("parametres").Select
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 2)
End If
Next i
Workbooks(FileName).Activate
Sheets(datejour).Select
Cells(2, ii + 2) = cel3
Next ii

End Sub


Y a til une alternative a Workbooks(FileName).Activate qui fait des aller et venu et fait scintiller l'ecran, et peut etre perdre du tps ds le calcul.

Merci par avance pour vos remarques....

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonsoir,

Un petit Up !

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonjour à vous tous,

Petit Up du matin si quelqu'un passe par la !

Bonne journée à vous tous

 

[LORDDD]

Re : Code- Faire une recherche ds un classeur et copier le résultat dans 2eme classeu

Bonjour à vous tous,

N'ayant pas d'avis sur mon code je post l'avancement ca peut aider quelqu'un

Voici le code :

Sub Action()
Application.ScreenUpdating = False
Dim datejour As String 'nom onglet date de depart'
Dim dateref As String 'nom onglet date ref antérieure'
Dim FileName As Variant 'nom du classeur data
Dim ThePath As String
Dim Classeur1 As String 'nom du classeur Cale Tarifs
Dim cel1 As String 'Segment de départ
Dim cel2 As String 'segment parametre
Dim cel3 As String 'résultat code segment
Dim i As Integer 'compteur de ligne
Dim ii As Integer 'compteur de ligne
Dim iii As Integer 'compteur de ligne
Dim iiii As Integer 'compteur de ligne
Dim Som As Single 'adition segment

Classeur1 = ActiveWorkbook.Name
Sheets("Parametres").Select

'------------------------------------------------------
'saisie des données de date
datejour = InputBox("Saisir date du jour sous forme dd-mm-aaaa !")

dateref = InputBox("Saisir date de ref sous forme dd-mm-aaaa !")
Range("D1") = datejour
Range("D3") = dateref
'------------------------------------------------------
'Annulation des filtres de tris'
Sheets("Point Tarifs").Select
Application.Run "'01-Cale Tarifs 2012.xls'!Effacer_tri_filtre"
Sheets("Hotel 1").Select
Application.Run "'01-Cale Tarifs 2012.xls'!Effacer_tri_filtre"
'------------------------------------------------------
'Ouverture du fichier data'
'Selection du classeur sous format xls'
FileName = Application.GetOpenFilename(fileFilter:="xls Files (*.xls), *.xls")
If FileName = False Then Exit Sub
'ouverture du classeur'
ThePath = FileName
Workbooks.Open FileName

FileName = ActiveWorkbook.Name
'------------------------------------------------------
'Position sur 1er date et nettoyage des codes segment
Sheets(datejour).Select
Range("b2:ab2").ClearContents 'nettoyage code hotel 1
Range("ae2:be2").ClearContents 'nettoyage code hotel 2
Range("bh2:ch2").ClearContents 'nettoyage code hotel 3
Range("ck2:dk2").ClearContents 'nettoyage code hotel 4
'Position sur 2eme date et nettoyage des codes segment
Sheets(dateref).Select
Range("b2:ab2").ClearContents 'nettoyage code hotel 1
Range("ae2:be2").ClearContents 'nettoyage code hotel 2
Range("bh2:ch2").ClearContents 'nettoyage code hotel 3
Range("ck2:dk2").ClearContents 'nettoyage code hotel 4
'------------------------------------------------------
'Attribution des codes segments Hotel 1 1er page
For ii = 0 To 26
Workbooks(FileName).Worksheets(dateref).Activate
cel1 = Cells(3, ii + 2)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 2)
End If
Next i
Workbooks(FileName).Worksheets(dateref).Activate
Cells(2, ii + 2) = cel3
Next ii

'Attribution des codes segments Hotel 2 1er page
For ii = 0 To 26
Workbooks(FileName).Worksheets(dateref).Activate
cel1 = Cells(3, ii + 31)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 3)
End If
Next i
Workbooks(FileName).Worksheets(dateref).Activate
Cells(2, ii + 31) = cel3
Next ii

'Attribution des codes segments Hotel 3 1er page
For ii = 0 To 26
Workbooks(FileName).Worksheets(dateref).Activate
cel1 = Cells(3, ii + 60)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 4)
End If
Next i
Workbooks(FileName).Worksheets(dateref).Activate
Cells(2, ii + 60) = cel3
Next ii

'Attribution des codes segments Hotel 4 1er page
For ii = 0 To 26
Workbooks(FileName).Worksheets(dateref).Activate
cel1 = Cells(3, ii + 89)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 5)
End If
Next i
Workbooks(FileName).Worksheets(dateref).Activate
Cells(2, ii + 89) = cel3
Next ii
'------------------------------------------------------
'Attribution des codes segments Hotel 1 2eme page
For ii = 0 To 26
Workbooks(FileName).Worksheets(datejour).Activate
cel1 = Cells(3, ii + 2)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 2)
End If
Next i
Workbooks(FileName).Worksheets(datejour).Activate
Cells(2, ii + 2) = cel3
Next ii

'Attribution des codes segments Hotel 2 2eme page
For ii = 0 To 26
Workbooks(FileName).Worksheets(datejour).Activate
cel1 = Cells(3, ii + 31)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 3)
End If
Next i
Workbooks(FileName).Worksheets(datejour).Activate
Cells(2, ii + 31) = cel3
Next ii

'Attribution des codes segments Hotel 3 2eme page
For ii = 0 To 26
Workbooks(FileName).Worksheets(datejour).Activate
cel1 = Cells(3, ii + 60)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 4)
End If
Next i
Workbooks(FileName).Worksheets(datejour).Activate
Cells(2, ii + 60) = cel3
Next ii

'Attribution des codes segments Hotel 4 2eme page
For ii = 0 To 26
Workbooks(FileName).Worksheets(datejour).Activate
cel1 = Cells(3, ii + 89)
cel3 = "NA"
For i = 0 To 26
Workbooks(Classeur1).Worksheets("parametres").Activate
cel2 = Cells(i + 6, 1)
If cel1 = cel2 Then
cel3 = Cells(i + 6, 5)
End If
Next i
Workbooks(FileName).Worksheets(datejour).Activate
Cells(2, ii + 89) = cel3
Next ii
'------------------------------------------------------
'Copie des segments par regroupement du classeur Data Vers classeur Cales
Workbooks(Classeur1).Worksheets("HOTEL 1").Activate
Range("d7:m372").ClearContents
For i = 0 To 365 'compteur du tableau de synthese ligne
Workbooks(Classeur1).Worksheets("HOTEL 1").Activate
date1 = Cells(i + 7, 3)
For ii = 0 To 731 'compteur du tableau source ligne
Workbooks(FileName).Worksheets(datejour).Activate
date2 = Cells(ii + 4, 1)

If date1 = date2 Then

For iii = o To 9 'compteur tableau de synthese colone
Som = 0
Workbooks(Classeur1).Worksheets("HOTEL 1").Activate
cel1 = Cells(5, iii + 4)

For iiii = o To 26 'compteur tableau source colone
Workbooks(FileName).Worksheets(datejour).Activate
cel2 = Cells(2, iiii + 2)

If cel2 = cel1 Then
Som = Som + Cells(ii + 4, iiii + 2)
End If
Next iiii

Workbooks(Classeur1).Worksheets("HOTEL 1").Activate
Cells(i + 7, iii + 4) = Som

Next iii

End If
Next ii
Next i

'------------------------------------------------------
Application.ScreenUpdating = True
'------------------------------------------------------
'Somme du tableau se synthése
Workbooks(Classeur1).Worksheets("HOTEL 1").Activate
For i = o To 365
Som = 0
For ii = 0 To 9
Som = Som + Cells(i + 7, ii + 4)
Next ii

Cells(i + 7, 14) = Som
Next i
MsgBox ("travail terminé")

End Sub

Et le fichier qui vat avec

Bonne journée,
Nhésitez pas à donner votre avis ou modif pour gagner du temps dans le deroulement du code

Cordialement a vous tous