Récuperer données de la cellule de droite

Le 28/09/2010 à 09:03
33total-v2-ok.zip (30.72 Ko)
33total-v2-ok.zip (30.72 Ko)
Yvouille a écrit :

Pourquoi ne pas plutôt mettre ton fichier sur le fil (déjà indiqué deux fois ) ?

Désolé j'ai completement oublié, le voici:

Le 28/09/2010 à 21:28

Salut Flo,

Je présume que les deux derniers fichiers que tu as placés sur ton fil sont exactement les mêmes. Si non, peux-tu nous en expliquer les différences, si oui, peux-tu à l'avenir n'en mettre qu'un seul ? L'aperçu permet de contrôler son message avant de le poster.

Tu as maintenant des feuilles complémentaires. Est-ce que l'une de ces trois nouvelles feuilles est la feuille 3 dont tu parlais plus haut ??

Tu m'indiques que lorsque tu lances la macro, elle efface les formules dans les autres feuilles que la feuille 2. De quelles autres feuilles parles-tu ? Ou parles-tu plutôt des autres colonnes de la feuille 2 ? Et parles-tu de formules ou de valeurs ? Peux-tu être plus précis ? Ou alors voudrais-tu que les résultats découlant d'un nouveau contrôle par ce code de nouvelles données importées dans la feuille 1 soient ajoutés aux résultats déjà présents sur la feuille 2 ? Dans ce cas, c'est normal que les anciens résultats soient suprimés, puisque j'ai placé un effacement de certaines colonnes au début de mon code :

Sheets("Feuil2").Select

Range("A2:A65000, B2:B65000, I2:H65000, D2:N65000, E2:O65000, G2:P65000").ClearContents

Si tu désirais compléter certains résultats au fur et à mesure, il fallait l'indiquer (ou l'indiquer maintenant).

Ou est-ce que tu désirais que les nouveaux résultats soient ajoutés 1 fois sur la feuille 2 avec effacement des anciens puis 1 fois aux résultats déjà en place sur une autre feuille ?

On peut (pratiquement) tout automatiser par des codes ! Il faut cependant connaître exactement tes désirs.

A te relire.

Le 08/10/2010 à 10:19

Bonjour à tous,

j'avais pris des congés mais me revoilà.

Pour répondre à tes questions précédents Yvouille, je me suis débrouillé en faisant une autre feuil qui me récupérais les données de la feuil1 et fait des calculs dessus.

J'ai un autre souci désormais. Je ne sais pas si je dois ouvrir un autre fil car ce souci est lié à ce post.

j'ai une macro qui me récupère; dans le repertoire où se situe le classeur contenant cette macro; une plage de cellules dans tous les fichiers html présents (j'ai changer seulement l'extension du fichier exemple pour le mettre sur le forum mais c'est normalement une fichier html); en ouvrant puis fermant chaque fichier. Ensuite une 2ème macro (celle de ce post) me récupère les données qui m'intéresse dans cette plage de cellules. Cependant j'ai des données qui ne sont pas dans cette plage de données et qui ne sont pas au même endroi selon les fichiers.

J'aimerais si possible, une macro qui me récupère, cette fois-ci pas la plage de cellules voulue mais directement les cellules contenant (car il y a d'autres caractères dans la cellules) : "Product ID : "; "Serial Number: " ; "Time: "; "UUT Results: "; "Execution Time: "

Puis qu'elle me mette sur la même ligne les données récupérés de chaque fichiers.

Je vous met un exemple de fichiers dans lequel je veux récupérer ces données et les macro ci dessous.

Merci grandement de votre aide.

macro1:

Public Sub cmdRecupere_Click()
Dim strWB As String, strFile As String

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\*.html")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Copie des données
Workbooks(strFile).Worksheets(1).Range("A21:C35").Copy
With Workbooks(strWB).Worksheets("Feuil1")
  .Range("A2").Insert xlDown 'insertion en ligne 2
  .Range("C2:C16").ClearContents 'on ne garde que les données A2:B17
  .Range("C2") = strFile
End With

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub

macro2:

Option Explicit

Sub Recherche_dates()

Dim Date_reportee As String, Code_reportee As String, Serial_reportee As String, Resultat_reportee As String, Time_reportee As Date, Execution_reportee As Date, DerLig As Integer, DerLig_F1 As Integer, i As Long

Application.ScreenUpdating = False

' suppression des lignes vides
Sheets("Feuil1").Select
DerLig_F1 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = DerLig_F1 - 1 To 1 Step -1
    Range("A" & i).Select
    If ActiveCell = "" Then
        ActiveCell.EntireRow.Delete
    End If
Next

Sheets("Feuil2").Select
Range("A2:A65000, B2:B65000, I2:H65000, D2:N65000, E2:O65000, G2:P65000").ClearContents

Sheets("Feuil1").Select
Range("A1").Select

Do Until ActiveCell = ""
    If ActiveCell.Value = "Date: " Then
        Date_reportee = ActiveCell.Offset(0, 1).Value
        Sheets("Feuil2").Select
        DerLig = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
        Range("D" & DerLig + 1).Select
        ActiveCell = Date_reportee
    Else
        If ActiveCell.Value = "Code" Then
        Code_reportee = ActiveCell.Offset(0, 1).Value
        Sheets("Feuil2").Select
        DerLig = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        Range("A" & DerLig + 1).Select
        ActiveCell = Code_reportee
    Else
        If ActiveCell.Value = "Serial Number: " Then
        Serial_reportee = ActiveCell.Offset(0, 1).Value
        Sheets("Feuil2").Select
        DerLig = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
        Range("B" & DerLig + 1).Select
        ActiveCell = Serial_reportee
    Else
        If ActiveCell.Value = "UUT Result: " Then
        Resultat_reportee = ActiveCell.Offset(0, 1).Value
        Sheets("Feuil2").Select
        DerLig = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
        Range("I" & DerLig + 1).Select
        ActiveCell = Resultat_reportee
    Else
        If ActiveCell.Value = "Time: " Then
        Time_reportee = ActiveCell.Offset(0, 1).Value
        Sheets("Feuil2").Select
        DerLig = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
        Range("E" & DerLig + 1).Select
        ActiveCell = Time_reportee
    Else
        If ActiveCell.Value = "Execution Time: " Then
        Execution_reportee = ActiveCell.Offset(0, 1).Value
        Sheets("Feuil2").Select
        DerLig = ActiveSheet.Range("G" & Rows.Count).End(xlUp).Row
        Range("G" & DerLig + 1).Select
        ActiveCell = Execution_reportee

    End If
    End If
    End If
    End If
    End If
    End If

    Sheets("Feuil1").Select
    ActiveCell.Offset(1, 0).Select
Loop

End Sub
23classeur2.zip (3.24 Ko)
Le 08/10/2010 à 11:38

Salut Flo,

Jusqu'à mes versions V2, je t'avais proposé un code assez compliqué, sautant d'une feuille à l'autre. Le 24 septembre, je t'ai proposé une version V3 avec le code ci-dessous :

Range("A1").Select
DerLig_F1 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To DerLig_F1
        If ActiveCell.Value = "Date: " Then
        Date_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("N" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("N" & DerLig + 1) = Date_reportee
    Else
        If ActiveCell.Value = "Code" Then
        Code_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("A" & DerLig + 1) = Code_reportee
    Else
        If ActiveCell.Value = "Serial Number: " Then
        Serial_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("B" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("B" & DerLig + 1) = Serial_reportee
    Else
        If ActiveCell.Value = "UUT Result: " Then
        Resultat_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("H" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("H" & DerLig + 1) = Resultat_reportee
    Else
        If ActiveCell.Value = "Time: " Then
        Time_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("O" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("O" & DerLig + 1) = Time_reportee
    Else
        If ActiveCell.Value = "Execution Time: " Then
        Execution_reportee = ActiveCell.Offset(0, 1).Value
        DerLig = Worksheets("Feuil2").Range("P" & Rows.Count).End(xlUp).Row
        Worksheets("Feuil2").Range("P" & DerLig + 1) = Execution_reportee

    End If
    End If
    End If
    End If
    End If
    End If

    ActiveCell.Offset(1, 0).Select
Next

Ce code - bien qu'il soit probablement encore améliorable - était bien plus simple que celui que tu continues à utiliser, selon ton dernier message ; c'est bien dommage, car tu compliques (et nous compliques) le travail inutilement. De plus ce nouveau code fonctionnait même s'il y avait des lignes vides, sans plus modifier ton document de base.

Autrement tu n'as pas cessé de ne pas fournir tes fichiers (dans le dernier message, tu livres 50 lignes de codes, mais pas de fichier utilisable, juste un fichier qui s'ouvre chez nous avec un message d'avertissement d'erreurs) malgré mes nombreuses demandes, tu ne nous fournis les renseignements qu'au compte-gouttes, tu n'arrêtes pas d'apporter de nouvelles exigences. Alors moi, je jettes l'éponge

A l'avenir, si tu veux mettre en ligne un bout de code, utilise s'il-te-plait les balises "Code", comme je l'ai fait ci-dessus, c'est plus facile à lire. Ton idée d'ouvrir un nouveau fil me paraît également intéressante.

Bonnes salutations.

Le 08/10/2010 à 13:07

Ne jettes pas l'éponge s'il te plaît Yvouille, je ne donne pas les infos au compte goutte c'est jusque pour voir les messages je suis obligé de cliquer sur répondre car sinon le post ne s'actualise pas. Et je ne peux pas te joindre le fichier car il est trop gros. Je vais utiliser ton nouveau code que je n'avais pas vu à cause du problème citer ci-avant.

Et ce n'est pas que j'apporte de nouvelles exigences c'est que j'essaye d'améliorer mon fichier (et mes connaissances) au fur et à mesure. J'ouvre donc un nouveau post mais ne m'abandonnez pas.

Merci pour tout

Rechercher des sujets similaires à "recuperer donnees droite"