VBA Excel Résolu/Fermé

Question

Bonjour, 

Ca fait un peu plus d'une semaine que j'ai découvert la programmation vba sur excel et je rencontre un problème m'empechant de réaliser ma programmation. 
Ma programmation est telle qu'elle doit réaliser des extractions à partir d'excel de plusieurs chaines de caractères (correspondant à des coordonnées) dans un fichier txt (bloc note). Cette tâche a été faite par les fonction InStr() et Mid(). Pour plus d'information, il y a x mesures de 16 coordonnées. Après je doit placer ces extractions dans des cellules du classeur excel de la manière suivante : sur une ligne que l'on précisera il y aura une coordonées , chaque cellule de la ligne (colonne = x mesure) doit prendre une extraction. Mon code pour ce tache est le suivant : 

Dim var1 As String, x As String 'Déclaration des variables 

Dim vari As Integer, colonne As Integer, ligne As Integer 
vari = FreeFile() 'Fonction pour obtenir le prochain numéro de fichier disponible 
Open "C:\Documents and Settings\Stagiaire\Bureau\Prog_robot.txt" For Input As #1 'Ouverture du fichier 

While Not EOF(1) 'Tant que la lecture du fichier n'est pas fini 
Input #1, var1 'Lecture des données du fichier Prog_robot et les attribue à une variable 


For colonne = 2 To 100 Step 1 'débute à la deuxièmre colonne et fin à la centième 
ligne = 2 

If Cells(ligne, colonne) = "" Then 'Si la première cellule est vide alrs 
If InStr(1, var1, "PALETTE FLACONS") <> 0 Then  'la remplir des caractères extrait dans le fichier txt 
Worksheets("Feuil1").Cells(ligne, colonne).Value = Mid(var1, 2, 17) 
End If 
Else: Cells(ligne, colonne + 1) = Mid(var1, 2, 17) 'Sinon passer à la colonne suivante et 
Worksheets("Feuil1").Cells(ligne, colonne).Value = Mid(var1, 2, 17) 'la remplir des caractères ectrait dans le fichier txt 
End If 'Fin de la condition Si 
Next colonne 



Le problème que je rencontre est que chaque colonne de la ligne garde la dernière extraction sans tenir compte des précédentes. 
Si quelqu'un pourrez m'aider à régler ce problème par une autre proposition de code ou modification de code ca serait gentil. 
Merci d'avance Cyril 
 
 




Configuration: Windows XP / Internet Explorer 8.0

Utilisateur anonyme · Answer

Salut,

N'ayant pas le fichier de données, il m'est impossible de tester !

Toutefois, j'ai pu corriger un peu ta syntaxe et ton algorithme :-)


Sub Test()

    'Déclaration des variables
    Dim var1 As String, x As String
    Dim vari As Integer, colonne As Integer, ligne As Integer
    
    'Fonction pour obtenir le prochain numéro de fichier disponible
    vari = FreeFile()
    'Ouverture du fichier
    Open "C:\Documents and Settings\Stagiaire\Bureau\Prog_robot.txt" For Input As #vari

    'Tant que la lecture du fichier n'est pas fini
    While Not EOF(vari)
        ligne = 2
        For colonne = 2 To 16
            'Lecture des données du fichier Prog_robot et les attribue à une variable
            Input #vari, var1
            ' Si fin de fichier, sortir de la boucle
            If (EOF(vari)) Then
                Exit For
            End If
            'Remplir des caractères extrait dans le fichier txt
            If InStr(1, var1, "PALETTE FLACONS") <> 0 Then
                Worksheets("Feuil1").Cells(ligne, colonne).Value = Mid(var1, 2, 17)
            Else
                Worksheets("Feuil1").Cells(ligne, colonne).Value = "Non Valide"
            End If
        Next colonne
    Wend

    Close #vari

End Sub
'


Cdt

Lupin

damlaine · Answer

Merci pour ta réponse mais ca ne marche pas. On m'a dit qu'il faudrai utiliser les pointeurs mais je ne sais pas du tout comment faire avc cet outil. Serais tu l'utiliser et le mettre en application pour la tache que je voudrait programmer qui est je le rappelle extraire des données d'un bloc note( données= 16 coordonnées correspondant à une mesure. Il y a x mesures) et placer chaque mesures dans des colonnes différentes cad colonne 2 : mesure 1, colonne3: mesure 2 etc et ligne 2 : coordonnées 1 ligne 3: coordonnées 2 etc

Polux31 · Answer

Bonjour,

Je pense qu'il faut que tu incrémentes la variable "ligne".

Tu restes sur la ligne 2 ^^

Penses à l'incrémenter en fin de boucle avant de passer à l'enregistrement suivant.

;o)

Utilisateur anonyme · Answer

re:

Très pertinent Polux :-)

Lupin

damlaine · Answer

Nan c'est pas ca mauvaise suggestion une ligne correspond à une des extractions et les colonnes correspond au différentes mesures

Utilisateur anonyme · Answer

re:

Il serait souhaitable que tu énonce ici la séquence
exacte de ton fichier texte, un exemple concret
du fichier source et du résultat souhaité !

Ce sera plus facile d'identifier le problème :-)

Cdt

Lupin

damlaine · Answer

Mon fichier texte ressemble est sous cette forme : sachant que dedans il x mesures plateau flacons
[JUN 22 2011 11:00:09]: USR: MESURES PLATEAU FLACONS : 999
[JUN 22 2011 11:00:09]: USR:D(O/XY)=1536.12
[JUN 22 2011 11:00:09]: USR:D(O/XY)-D(X/Y)=50.23
[JUN 22 2011 11:00:09]: USR:D(O/X)-D(Y/XY)=-0.62
[JUN 22 2011 11:00:09]: USR:D(O/Y)-D(X/XY)=2.35
[JUN 22 2011 11:00:09]: USR:D(A2/A7)=1219.77 ; E(A2)=62.78 ; E(A7)=1282.07
[JUN 22 2011 11:00:09]: USR:D(A3/A6)=1221.53 ; E(A3)=20.24 ; E(A6)=1241.25
[JUN 22 2011 11:00:09]: USR:D(B1/B4)=1168.04 ; E(B1)=-189.57 ; E(B4)=978.42
[JUN 22 2011 11:00:09]: USR:D(B8/B5)=1172.19 ; E(B8)=-188.99 ; E(B5)=983.16
[JUN 22 2011 11:00:09]: USR:FIN MESURES
[JUN 22 2011 11:01:43]: USR: MESURES PLATEAU FLACONS : 998
[JUN 22 2011 11:01:43]: USR:D(O/XY)=1535.85
[JUN 22 2011 11:01:43]: USR:D(O/XY)-D(X/Y)=38.87
[JUN 22 2011 11:01:43]: USR:D(O/X)-D(Y/XY)=-0.58
[JUN 22 2011 11:01:43]: USR:D(O/Y)-D(X/XY)=6.61
[JUN 22 2011 11:01:43]: USR:D(A2/A7)=1219.61 ; E(A2)=62.34 ; E(A7)=1281.65
[JUN 22 2011 11:01:43]: USR:D(A3/A6)=1221.48 ; E(A3)=25.43 ; E(A6)=1246.58
[JUN 22 2011 11:01:43]: USR:D(B1/B4)=1167.98 ; E(B1)=-189.57 ; E(B4)=978.36
[JUN 22 2011 11:01:43]: USR:D(B8/B5)=1172.17 ; E(B8)=-188.92 ; E(B5)=983.21
[JUN 22 2011 11:01:43]: USR:FIN MESURES

Donc j'aimerai que mon tableau se construit de cette maniere : chaque ligne correspond à une coordonnées cad D(O/XY), D(O/XY)-D(X/Y), etc et une ligne date et dans les colonnes le numéro de la mesure ici ca serait 998 puis 999. Donc comment faire que chaque coordonnées se met dans les cellules voulues

Utilisateur anonyme · Answer

re: 

Bon, maintenant c'est plus clair et l'on voit se dessiner le résultat. 

Une autre question : 

Lorsqu'il y a plus d'une donnée dans la ligne, exemple : 
[JUN 22 2011 11:01:43]: USR:D(B8/B5)=1172.17 ; E(B8)=-188.92 ; E(B5)=983.21  

Comment faut-il traiter cette ligne ? 
Trois données dans une cellule ? Une donnée par cellule ? 

En attendant, voici un premier jet du code testé : 

Note :  

1.) Lorsqu'il y a trois données sur la ligne, elles sont copiées dans une cellules. 

2.) L'appel de la fonction [NettoieCoordonnees] enlève l'adressage, 
.....Si ce n'est pas nécessaire, enlève l'appel -> 

    Reponse = NettoieCoordonnees 
     
    If (Reponse) Then 
        MsgBox "Traitement Réussi." 
    Else 
        MsgBox "Mise en forme incomplète" 
    End If 



Option Explicit 

Sub Test() 

    'Déclaration des variables 
    Dim var1 As String, x As String 
    Dim vari As Integer, colonne As Integer, ligne As Integer 
    Dim Indice As String, Reponse As Boolean 
     
    'Fonction pour obtenir le prochain numéro de fichier disponible 
    vari = FreeFile() 
    'Ouverture du fichier 
    Open "C:\Document\Prog_robot.txt" For Input As #vari 

    ligne = 2 
    'Tant que la lecture du fichier n'est pas fini 
    While Not EOF(vari) 
         
        For colonne = 1 To 10 
            'Lecture des données du fichier Prog_robot et les attribue à une variable 
            Input #vari, var1 
            ' Si fin de fichier, sortir de la boucle 
            If (EOF(vari)) Then 
                Exit For 
            End If 
            'Remplir des caractères extrait dans le fichier txt 
            If InStr(1, var1, "PLATEAU FLACONS") <> 0 Then 
                Indice = Right(Trim(var1), 3) 
                Worksheets("Feuil1").Cells(ligne, colonne).Value = Indice 
            Else 
                If InStr(1, var1, "FIN MESURES") = 0 Then 
                    Worksheets("Feuil1").Cells(ligne, colonne).Value = Mid(var1, 24) 
                End If 
            End If 
        Next colonne 
        ligne = (ligne + 1) 
    Wend 

    Close #vari 

    Reponse = NettoieCoordonnees 
     
    If (Reponse) Then 
        MsgBox "Traitement Réussi." 
    Else 
        MsgBox "Mise en forme incomplète" 
    End If 

End Sub 
' 

Private Function NettoieCoordonnees() As Boolean 

    Dim Valeur As Variant, Boucle As Long 
    Dim Resultat As String 
    Dim Coordonne As String, Position As Long 
    Dim Plage As Range, Cible As Range 

    On Error GoTo Err_NettoieCoordonnees 

    NettoieCoordonnees = False 
    Set Plage = ActiveSheet.UsedRange 
     
    For Each Cible In Plage 
        Resultat = "" 
        Valeur = Split(Cible.Value, ";", , vbTextCompare) 
        For Boucle = 0 To UBound(Valeur) 
            Position = InStr(1, Valeur(Boucle), "=", vbTextCompare) 
            Resultat = Resultat & Mid(Valeur(Boucle), Position + 1) & ";" 
        Next Boucle 
        Cible.Value = Left(Resultat, (Len(Resultat) - 1)) 
    Next Cible 
     
    NettoieCoordonnees = True 

Exit_NettoieCoordonnees: 
    Exit Function 

Err_NettoieCoordonnees: 
    NettoieCoordonnees = False 

End Function 
' 


Cdt 

Lupin

Ismael · Answer

Cette solution t'as-t-elle donné satisfaction? Sinon je pense que tu peux t'orienter vers un codage en C++, compilé sous forme de DLL. Ainsi tu pourras accéder plus facilement à la zone mémoire ou sont stockées tes coordonnées et ainsi t'économiser du temps de calcul.

damlaine · Answer

Merci Lupin mais hier soir j'y suis arriver à avoir le résultat voulu voici le code : Open "C:\Documents and Settings\Stagiaire\Bureau\Prog_robot.txt" For Input As #1 'Ouverture du fichier colonne = 2 While Not EOF(1) 'Tant que la lecture du fichier n'est pas fini Input #1, var1 'Lecture des données du fichier Prog_robot et les attribue à une variable If InStr(1, var1, "PALETTE FLACONS") <> 0 Then 'InStr renvoie la position de la première chaine de caractère à l'intérieur d'une autre Worksheets("Feuil1").Cells(1, colonne).Value = Mid(var1, 57, 2) 'Mid extrait le nombre de caractères voulus End If If InStr(1, var1, "PALETTE FLACONS") <> 0 Then Worksheets("Feuil1").Cells(2, colonne).Value = Mid(var1, 2, 17) End If If InStr(1, var1, "D(O/XY)=") <> 0 Then Worksheets("Feuil1").Cells(3, colonne).Value = Mid(var1, 37, 7) End If If InStr(1, var1, "D(O/XY)-D(X/Y)=") <> 0 Then Worksheets("Feuil1").Cells(4, colonne).Value = Mid(var1, 44, 5) End If If InStr(1, var1, "D(O/X)-D(Y/XY)=") <> 0 Then Worksheets("Feuil1").Cells(5, colonne).Value = Mid(var1, 44, 3) End If If InStr(1, var1, "D(O/Y)-D(X/XY)=") <> 0 Then Worksheets("Feuil1").Cells(6, colonne).Value = Mid(var1, 44, 5) End If If InStr(1, var1, "D(A2/A7)=") <> 0 Then Worksheets("Feuil1").Cells(7, colonne).Value = Mid(var1, 38, 7) End If If InStr(1, var1, "D(A3/A6)=") <> 0 Then Worksheets("Feuil1").Cells(8, colonne).Value = Mid(var1, 38, 7) End If If InStr(1, var1, "D(B1/B4)=") <> 0 Then Worksheets("Feuil1").Cells(9, colonne).Value = Mid(var1, 38, 7) End If If InStr(1, var1, "D(B8/B5)=") <> 0 Then Worksheets("Feuil1").Cells(10, colonne).Value = Mid(var1, 38, 7) End If If InStr(1, var1, "E(A2)=") <> 0 Then Worksheets("Feuil1").Cells(11, colonne).Value = Mid(var1, 54, 5) End If If InStr(1, var1, "E(A7)=") <> 0 Then Worksheets("Feuil1").Cells(12, colonne).Value = Mid(var1, 68, 7) End If If InStr(1, var1, "E(A3)=") <> 0 Then Worksheets("Feuil1").Cells(13, colonne).Value = Mid(var1, 54, 5) End If If InStr(1, var1, "E(A6)=") <> 0 Then Worksheets("Feuil1").Cells(14, colonne).Value = Mid(var1, 68, 7) End If If InStr(1, var1, "E(B1)=") <> 0 Then Worksheets("Feuil1").Cells(15, colonne).Value = Mid(var1, 54, 7) End If If InStr(1, var1, "E(B4)=") <> 0 Then Worksheets("Feuil1").Cells(16, colonne).Value = Mid(var1, 70, 6) End If If InStr(1, var1, "E(B8)=") <> 0 Then Worksheets("Feuil1").Cells(17, colonne).Value = Mid(var1, 54, 7) End If If InStr(1, var1, "E(B5)=") <> 0 Then Worksheets("Feuil1").Cells(18, colonne).Value = Mid(var1, 70, 5) End If If InStr(1, var1, "FIN MESURES") <> 0 Then colonne = colonne + 1 End If Wend 'Montre la fin de la boucle While Close #1 'Fermeture du fichier Prog_robot MsgBox "Fin du programme" Voilà, mtn j'ai un autre soucis c'est qu'en fonction du numéro dans le fichier aps palette flacons indique le numéro de la colonne. Ainsi, PALETTE FLACONS : 10 doit se placer dans la dixième colonne. Pour cela j'ai fait ce code mais sans grand succes : If InStr(1, var1, "PALETTE FLACONS") <> 0 Then x = Mid(var1, 57, 2) colonne = CInt(x) End If Quel est le problème ? Et j'aimerai aps que tout les caractères que j'ai rentrée (les coordonnées) se convertissent pour pourvoir faire des comparaisons. Si tu as la solution pourrais-tu me la transmettre s'il te plait merci Cyril

Ismael · Answer

colonne = CInt(x) :

Pourquoi modifier ton compteur de colonne en cours de remplissage de ta feuille??

damlaine · Answer

colonne = CInt (x) c'est ce que j'ai utilisé mais ca m'indique une erreur.
 Je voudrait modifier mon remplissage pour avoir les numéros de palette de flacons dans l'ordre car dans le fichier elle ne le sont pas.
Et par hasard là je procede a des comparaisons de cellules mais je rencontre une erreur que je n'arrive pas à corriger. Le code  est
For each Cells in Rows(3)
If Cells.Value <= Cells(23, 4).Value + Cells(23, 2) Then cell.interior.colorindex=4
Et je doit faire la meme chose mais avec une soustraction et aussi comparer les cellules sont dans un intervalle. MAis a chaque fois ma syntaxe est fausse. Help me !

Utilisateur anonyme · Answer

re: 

Quelques observations : 

Tu présente le code suivant : 

vari = FreeFile()  
Open "C:\Documents and Settings\Stagiaire\Bureau\Prog_robot.txt" For Input As #1  
While Not EOF(1) 
Input #1, var1 

Je corrige la syntaxe ainsi : 

vari = FreeFile()  
Open "C:\Documents and Settings\Stagiaire\Bureau\Prog_robot.txt" For Input As #vari 
While Not EOF(vari) 
Input #vari, var1 

A quoi bon utiliser la fonction FreeFile, si tu utilise #1 pour 
adresser le numéro de fichier ? 

Je vois que tu n'est pas très à l'aise avec mon code ? 

Utilise ce code pour capturer ton numéro de colonne : 


        Dim Indice As String, Position As Long, colonne As Long 

        If InStr(1, var1, "PALETTE FLACONS") <> 0 Then 
            Indice = Left(var1, InStrRev(var1, ":")) 
            Position = Len(Indice) 
            colonne = CLng(Mid(var1, Position + 1)) 
        End If 
' 


n.b. quand tu écris : x = Mid(var1, 57, 2), tu ne récupères que 
2 caractères, que feras tu pour les nombres > que 99 (i.e. à trois 
caractères ou plus) ? Utilise le code proposé ci-haut. 

Tu trouveras dans les propriétés de [Row] et [Column] que 
celles-ci sont de Type Long. 

Donc quand tu adresses les cellules avec l'instruction : 

Cells(Row,Column).Value 

avec des variables, ex.: colonne, celles-ci devrait toujours 
être déclaré de type Long. 

Dim colonne As Long 

Cdt 

Lupin

damlaine · Answer

Tu pourrais m'expliquer en détail ton code stp?
J'extrait slmnt deux caractères car le numéro de palette flacons va de 1 à 99.
Et aps j'ai des caractéres dans mes cellules et je doit faire des comparaisons donc il faut que je les convertisse en nombre pourrais tu m'aider pour cela ?
Merci cyril

Utilisateur anonyme · Answer

re:

Tu peux très bien comparer du texte !

Et que veux dire [aps] ?

Quel partie du code veux-tu que j'explique, quel numéro de topic ?

Lupin

damlaine · Answer

aps = après. Désolé j'aurai pas pu abrégé.
Pourtant j'y arrive pas à comparer les coordonnées que j'ai extrait. Je fait ceci :

Range("B22") = "Première limite"
Range("C22") = "Seconde limite"
Range("D22") = "Référence"
For Each cell In Range("B3:CV3")
If Cells.Value <= Cells(22, 4).Value + Cells(23, 2).Value Then
Cells.Interior.ColorIndex = 4
End If
Next cell


Et ton code ne marche pas. Il me dit erreur définie par l'application ou par l'objet. En me soulignant cette ligne de code :Worksheets("Feuil1").Cells(1, colonne).Value = Mid(var1, 57, 2)

Utilisateur anonyme · Answer

re: 

Procédons par étape : 

Quels sont les valeurs de la comparaison ? 

Je vois que : 
Cells(22, 4).Value = Référence 

Mais je ne sais pas : 

Cells(23, 2).Value  

Si c'est du texte, il faut écrire : 

Cells(22, 4).Value & Cells(23, 2).Value pour concatener les deux. 

La ligne suivante : 
If Cells.Value <= Cells(22, 4).Value + Cells(23, 2).Value Then 

me semble en erreur ! 
Ce ne serait pas plus tôt : 

If Cell.Value <= Cells(22, 4).Value & Cells(23, 2).Value Then 

Qu'est qu'il devrait y avoir dans chacune des cellules :

Cells(23, 2).Value  
Cell.Value


Lupin

damlaine · Answer

dans la cells(23, 2) c'est un chiffre rentré manuellement. Et c'est cells(23,4) et non cells(22,4) erreur de ma part. et dc cette cellule est aussi un chiffre rentrer manuellment pas l'utilisateur
J'ai essayé avec & il m'affiche incompatibilité de type

Utilisateur anonyme · Answer

re:

Dans les cas de problème de compatibilité, il faut
èlaborer de façon à rendre les promotions et démotions
de type plus explicite.

Exemple :

Sub EssaiCode()

    Dim PremierChiffrre As Long
    Dim SecondChiffre As Long
    Dim Resultat As Long
    Dim Valeur As Long

    Range("B22") = "Première limite"
    Range("C22") = "Seconde limite"
    Range("D22") = "Référence"

    PremierChiffrre = CLng(Cells(22, 4).Value)
    SecondChiffre = CLng(Cells(23, 2).Value)
    Resultat = PremierChiffrre + SecondChiffre
    
    For Each Cell In Range("B3:CV3")
        Valeur = CLng(Cell.Value)
        If (Valeur <= Resultat) Then
            Cells.Interior.ColorIndex = 4
        End If
    Next Cell

End Sub
'


Cdt

Lupin

damlaine · Answer

Je comprend parfaitement ton code merci d'ailleurs mais il m'affiche à nouveau le meme message. Je comprend pas du tout pourquoi

damlaine · Answer

c'est bon ça marche il fallait jsute enlever le s a cells.Interior etc.
Jte remercie beaucoup pour ton aide. 
Cyril

Utilisateur anonyme · Answer

re:

Excellent, celui-là m'avait échappé !

La variable Cell est à mon goût trop ressemblante
à l'instruction [Cells], c'est pourquoi j'utilise
habituellement le mot [Cible]

For Each Cible In Range("B3...")

Bonne continuité

Cdt

Lupin