Export de données avec reconnaissance de date

Version imprimable

11/10/2012, 19h18
Kimy_Ire

1 pièce(s) jointe(s)

Export de données avec reconnaissance de date

Bonjour à tous,

Je suis TRES loin d'être un expert en VBA et je ne sais absolument pas comment coder ce que je souhaite réaliser. J'imagine un code de taille et je comprendrais que je n'ai pas de réponse ou que l'on me dise d'aller voir ailleurs. ^^

Bref, j'explique tout de même mon souhait : j'importe depuis une base de données des séries de valeurs.
- Sur la première colonne je trouve une date d'un style particulier : 20121011 pour 11-oct-12.
- Sur une seconde colonne je trouve les données que je veux déplacer.

Tous les jours, la base de données est mise à jour et mon fichier excel importe les 7 dernières valeurs avec les dates correspondantes.
Je voudrais donc stocker ces valeurs dans une autre feuille excel en utilisant une fonction.

1) Celle-ci devrait comparer la date du format particulier (20121011) avec les dates (d'un format date = 11/10/2012) de mon autre feuille dans un premier temps.
2) Lorsque les deux dates concordent, il faut copier la valeur (situé sur l'onglet mis à jour tous les jours) à la place souhaitée sur le second onglet.

J'imagine que vous n'avez rien compris. Je vous met donc un fichier excel exemple en pièce jointe, qui, lui, j'espère, sera suffisamment précis.

Je vous remercie infiniment par avance de votre dévotion ! Je sais que vous n'êtes pas au service des autres mais vous arrivez à proposer des solutions même parfois complexe !
Je reste bien entendu à votre disposition pour toute précision !

Kimy

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub UpdateData()
Dim Str As String
Dim Dte As Date
Dim c As Range
 
With Worksheets("Feuil1")
    Str = .Range("A24")
    Dte = DateSerial(Left(Str, 4), Mid(Str, 5, 2), Right(Str, 2))
    Set c = .Range("J:J").Find(Dte, LookIn:=xlFormulas, lookat:=xlWhole)
    If Not c Is Nothing Then
        c.Offset(0, 1) = .Range("B24")
        c.Offset(0, 2) = .Range("E24")
        c.Offset(0, 3) = .Range("H24")
        Set c = Nothing
    End If
End With
End Sub

Bonjour à tous, bonjour Mercatog,

Tout d'abord merci de ta réponse qui fonctionne parfaitement sur le fichier que j'ai envoyé. En revanche la transposition pose un petit peu plus de soucis. Je met ci-dessous les modifications que j'y ai apporté pour répondre à mon problème :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub UpdateData() Dim Str As String Dim Dte As Date Dim c As Range ' With Worksheets("AutomatedAnaliticsPro") Str = Worksheets("AutomatedAnaliticsPro").Range("A12") Dte = DateSerial(Left(Str, 4), Mid(Str, 5, 2), Right(Str, 2)) Set c = Worksheets("BeamriseRawStats").Range("C:C").Find(Dte, LookIn:=xlFormulas, lookat:=xlWhole) If Not c Is Nothing Then Worksheets("BeamriseRawStats").c.Offset(0, 3) = Worksheets("AutomatedAnaliticsPro").Range("B12") Worksheets("BeamriseRawStats").c.Offset(0, 8) = Worksheets("AutomatedAnaliticsPro").Range("E12") Worksheets("BeamriseRawStats").c.Offset(0, 13) = Worksheets("AutomatedAnaliticsPro").Range("H12") Worksheets("BeamriseRawStats").c.Offset(0, 15) = Worksheets("AutomatedAnaliticsPro").Range("K12") Worksheets("BeamriseRawStats").c.Offset(0, 16) = Worksheets("AutomatedAnaliticsPro").Range("N12") Worksheets("BeamriseRawStats").c.Offset(0, 20) = Worksheets("AutomatedAnaliticsPro").Range("Q12") Worksheets("BeamriseRawStats").c.Offset(0, 18) = Worksheets("AutomatedAnaliticsPro").Range("T12") Worksheets("BeamriseRawStats").c.Offset(0, 21) = Worksheets("AutomatedAnaliticsPro").Range("W12") Set c = Nothing End If ' End With End Sub
Tout d'abord, lors de l'enregistrement sur mes onglets ou sur ma page de module je reçois le message d'avertissement suivant :

Citation:

Avertissement concernant la confidentialité : ce document contient des macros, des contrôles ActiveX, des informations sur le kit d'extension XML ou des composants Web. Ils peuvent renfermer des informations personnelles qui ne peuvent pas être supprimées par l'Inspecteur de document.

N'ayant jamais vu ce message, je ne sais pas l'importance qu'il a même si son contenu "ne me fait pas peur".
Ensuite, rien ne se passe quant à la macro... Je souhaite déplacer les éléments contenu dans les cellules (B,E,H,K,...12) de la feuille AutomatedAnaliticsPro vers les cellules (c+Offset(0, 3),Offset(0, 8),Offset(0, 13),Offset(0, 15),...) de la page BeamriseRawStats.

J'imagine que la formule ne rentre pas dans le "if" puisque il n'y a aucune cellule qui se met à jour.

Merci encore pour tout !!!

Bonjour
Je ne sais pas pourquoi tu as changé la structure du code (surtout avec le nom de ta feuille juste avant la variable c)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub UpdateData()
Dim Str As String
Dim Dte As Date
Dim c As Range
 
With Worksheets("AutomatedAnaliticsPro")
    Str = Worksheets("AutomatedAnaliticsPro").Range("A12")
    Dte = DateSerial(Left(Str, 4), Mid(Str, 5, 2), Right(Str, 2))
    Set c = Worksheets("BeamriseRawStats").Range("C:C").Find(Dte, LookIn:=xlFormulas, lookat:=xlWhole)
    If Not c Is Nothing Then
        c.Offset(0, 3) = .Range("B12")
        c.Offset(0, 8) = .Range("E12")
        c.Offset(0, 13) = .Range("H12")
        c.Offset(0, 15) = .Range("K12")
        c.Offset(0, 16) = .Range("N12")
        c.Offset(0, 20) = .Range("Q12")
        c.Offset(0, 18) = .Range("T12")
        c.Offset(0, 21) = .Range("W12")
        Set c = Nothing
    End If
End With
End Sub

Pour le fonctionnement du code tu as bien des dates en valeurs en colonne C ou issus d'une formule?

12/10/2012, 12h13
Kimy_Ire

Je suis juste un imbécile... J'avais essayé plein de choses différentes puisque cela ne fonctionnait pas et j'ai seulement mis le dernier code que j'avais utilisé.

Bref, le tiens marche niquel et je te remercie INFINIMENT pour ton aide !!!

Bonjour à tous,

Pour info, ce genre de conversion de date fonctionne très bien également:
Code:

1 2 3 4 5 6 7 8 Sub test() Dim dte As Date Dim strDate As String strDate = "20121011" dte = CDate(Format(strDate, "0000/00/00")) MsgBox dte End Sub