Code VBA Excel

Signaler
Messages postés
18
Date d'inscription
mardi 5 juillet 2011
Statut
Membre
Dernière intervention
24 juillet 2011
-
Messages postés
14760
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
19 janvier 2021
-
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

8 réponses

Messages postés
14760
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
19 janvier 2021
151
Bonjour,

Déjà, en regardant rapidement, tu déclare et assignes une variable "vari" avec un numéro de fichier, mais tu ne l'utilises pas, c'est normal ?

Sinon, peux-tu reposter ton code en utilisant la coloration syntaxique dispo sur le forum (3ième icone à partir de la droite) ?

Pense aussi si ce n'est pas fait à inferter ton code et à éviter de mettre plusieurs instructions (séparées par des ":") sur une même ligne, ça rend le code moins lisible.

Mon site
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
232
salut, Nhenry.
inferter infester ou infecter ou = indenter ?

____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP
Messages postés
18
Date d'inscription
mardi 5 juillet 2011
Statut
Membre
Dernière intervention
24 juillet 2011

Merci déjà pour d'avoir répondu mais ca ne résoud pas mon problème. As tu la solution ?
Et vlà ce que tu m'as demandé

Dim var1 As String, x As String  

Dim vari As Integer, colonne As Integer, ligne As Integer 
Open "C:\Documents and Settings\Stagiaire\Bureau\Prog_robot.txt" For Input As #1 
While Not EOF(1)  
Input #1, var1 

For colonne = 2 To 100 Step 1 
ligne = 2 
If Cells(ligne, colonne) = "" Then 
If InStr(1, var1, "PALETTE FLACONS") <> 0 Then 
Worksheets("Feuil1").Cells(ligne, colonne).Value = Mid(var1, 2, 17) 
End If 
Else: Cells(ligne, colonne + 1) = Mid(var1, 2, 17) 
Worksheets("Feuil1").Cells(ligne, colonne).Value = Mid(var1, 2, 17)
End If
Next colonne 

Messages postés
14760
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
19 janvier 2021
151
Bonjour,

ucfoutu, oui, c'est bien "indenter", les touches de mon clavier se sont inversées sans prévenir (toujours des excentriques ces claviers ... )

Damlaine, C'est déjà plus lisible, maintenant un peu d'indentation et de non utilisation du séparateur : serait mieux.

Je résume ton code :
Ouvrir un fichier texte

Faire jusqu'à la fin du fichier :

    Lire la première donnée (si présence de ; ou , , ne pas prendre toute la ligne (utiliser LINE INPUT pour éviter ce genre de comportement)

    POUR De la colonne 2 à la colonne 100
        Ligne=2
        Si la cellule (Ligne,Colonne) est vide ALORS
            SI La donnée lue contient "PALETTE FLACONS" ALORS
                Feuille("Feuille1").Cellule(ligne,colonne)=Partie de la donnée lue
            FIN SI
        SINON
            Cellule(ligne,colonne+1)=Partie de la donnée lue
            Feuille("Feuille1").Cellule(ligne,colonne)=Partie de la donnée lue
        FIN SI
    FIN POUR
Fin FAIRE


Est-ce que ce pseudo code correspond à ta demande ?
J'ai juste traduit ton code en français.

Dans le cas d'une cellule vide et que la condition du "contient" n'est pas respectée, la case reste vide.
Tu ne changes jamais de ligne
Tu semble agir sur 2 feuilles en n'en nommant qu'une explicitement.

Ensuite, ne connaissant pas le format du fichier entré ni le résultat désiré (exemples), je ne vois pas ce qui ne va pas.

Mon site
Messages postés
18
Date d'inscription
mardi 5 juillet 2011
Statut
Membre
Dernière intervention
24 juillet 2011

Mon fichier, bloc note (fichier txt), est sous cette forme :
[JUN 16 2011 10:41:24]: USR: MESURES PALETTE FLACONS : 10
[JUN 16 2011 10:41:25]: USR:D(O/XY)=1536.03
[JUN 16 2011 10:41:25]: USR:D(O/XY)-D(X/Y)=41.94
[JUN 16 2011 10:41:25]: USR:D(O/X)-D(Y/XY)=-0.38
[JUN 16 2011 10:41:25]: USR:D(O/Y)-D(X/XY)=21.99
[JUN 16 2011 10:41:25]: USR:D(A2/A7)=1219.75 ; E(A2)=63.29 ; E(A7)=1282.31
[JUN 16 2011 10:41:25]: USR:D(A3/A6)=1221.48 ; E(A3)=14.26 ; E(A6)=1234.97
[JUN 16 2011 10:41:25]: USR:D(B1/B4)=1168.06 ; E(B1)=-189.5 ; E(B4)=978.51
[JUN 16 2011 10:41:25]: USR:D(B8/B5)=1172.19 ; E(B8)=-188.77 ; E(B5)=983.39
[JUN 16 2011 10:41:25]: USR:FIN MESURES

avec x mesures palette flacons.

Dans mon classeur excel je veux mettre dans les lignes D(O/XY),D(O/XY)-D(X/Y), etc et en colonne les x mesures. Donc j'aurai x mesures pour D(O/XY), et x mesures pour les autres coordonnées.

Palette flacons......Mesure 1......Mesure 2......Mesure 3......etc
Date H:MN
D(O/XY)
D(O/XY)-D(X/Y)
D(O/X)-D(Y/XY)
etc
Donc faut extrait x fois les mesures de chaque coordonnées et le code que j'ai établi ne me permet que d'afficher les coordonées de la dernière mesure. Aurais tu une solution ? Un code à me proposer ou un indice pour que je puisse avancer stp
PS : Que veut tu dire pas indenter ?
Messages postés
14760
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
19 janvier 2021
151
Bonjour,

Donc, je résume :
Pour chaque groupe de mesure, faire :
Une nouvelle colonne
Remplir chaque cellule de la colonne en fonction de son Identifiant.

Composition des lignes de données :
[Date/heure]: USR:Identifiant=Valeur

Dans le cas de la valeur, est-ce que les valeurs composées comme
[JUN 16 2011 10:41:25]: USR:D(B8/B5)=1172.19 ; E(B8)=-188.77 ; E(B5)=983.39
Ont un traitement spécial ?

Dsl, mais ce soir, je n'ai pas spécialement le temps de faire un exemple de code.

Mon site
Messages postés
18
Date d'inscription
mardi 5 juillet 2011
Statut
Membre
Dernière intervention
24 juillet 2011

Mon fichier texte 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 mettent dans les cellules voulues

Qu'es que tu veux dire par traitement spécial ? (La coordonnée E(B8), E(B5) etc sont extrait de la meme manière que les autres coordonnées, fonction InStr() et Mid(). Si aujourd'hui tu as le tps de faire un exemple de code ca serait gentil merci
Messages postés
14760
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
19 janvier 2021
151
Bonjour,

Dim lColonne As Long
lColonne=0
Dim lLigne as String
Dim lDate as Date

Dim lTab1() as String
Dim lTab2() as String
Dim i As Long

Open "MonFichier" FOR Input As #1

Do Until Eof(1)
Line Input #1,lLigne
lDate=Mid$(lLigne,2,20)
lLigne=Mid$(lLigne,28)' On ne garde que la donnée utile

If Instr(lLigne," MESURE PLATEAU")=1 Then
'Nouvelle mesure
lColonne=lColonne+1

'Ajout du numéro de mesure
AddData lColonne,"Mesure",trim$(Split(lLigne,":")(1)

'Ajout de la date
AddData lColonne,"Date/Heure",lDate
Elseif Instr(lLigne,"=")<>0 Then
'Ligne de données
lTab1=Split(lLigne,";")

For i=lBound(lTab1) To uBound(lTab1)
lTab2=Split(Trim$(lTab1(i)),"=")
AddData lColonne,lTab2(0),lTab2(1)
Next
End if
Loop

Close #1




Public Sub AddData(ByVal pColonne as Long,ByVal pKey as String, ByVal pValue as String)
Dim lLigne as long
lLigne=1

Do while Cells(lLigne,1).Value<>"" And Cells(lLigne,1).Value<>pKey
lLigne=lLigne+1
Loop

'Si ligne non trouvée, on la créé
If Cells(lLigne,1).Value="" Then Cells(lLigne,1).Value=pKey

Cells(lLigne,1+pColonne).Value=pValue
End Sub


Code tapé hors de l'environnement, peut comporter des erreurs.

Normalement, ça devrait fonctionner, essayes de le tester en pas à pas pour voir ce qu'il fait.

Mon site