VBA Excel

Résolu
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention   -  
 Utilisateur anonyme -
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






22 réponses

  • 1
  • 2
Réponse 1 / 22
Utilisateur anonyme
 
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
1
Réponse 2 / 22
Utilisateur anonyme
 
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
0
Réponse 3 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Réponse 4 / 22
Polux31 Messages postés 6917 Date d'inscription   Statut Membre Dernière intervention   1 204
 
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)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 22
Utilisateur anonyme
 
re:

Très pertinent Polux :-)

Lupin
0
Polux31 Messages postés 6917 Date d'inscription   Statut Membre Dernière intervention   1 204
 
Bah, qui n'a jamais fait cette boulette ? ^^
0
Réponse 6 / 22
damlaine
 
Nan c'est pas ca mauvaise suggestion une ligne correspond à une des extractions et les colonnes correspond au différentes mesures
0
Polux31 Messages postés 6917 Date d'inscription   Statut Membre Dernière intervention   1 204
 
Tu boucles jusqu'à la fin du fichier, mais tu écris toujours sur la ligne 2 de ton fichier Excel.

Tu dis toi même : 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.

C'est tout simplement que tu n'incrémentes pas les lignes Excel.

Alors, je te suggères de mettre avant le Wend
ligne = ligne + 1

Tu reviendras nous dire si la suggestion est mauvaise ou pas ensuite.
0
damlaine
 
Je viens te dire que j'ai essayé ta suggestion elle n'a pas donnée le résultat voulu
0
Réponse 7 / 22
Utilisateur anonyme
 
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
0
Réponse 8 / 22
damlaine
 
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
0
Réponse 9 / 22
Utilisateur anonyme
 
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
0
Réponse 10 / 22
Ismael
 
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.
0
Réponse 11 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Réponse 12 / 22
Ismael
 
colonne = CInt(x) :

Pourquoi modifier ton compteur de colonne en cours de remplissage de ta feuille??
0
Réponse 13 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
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 !
0
Réponse 14 / 22
Utilisateur anonyme
 
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
0
Réponse 15 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Réponse 16 / 22
Utilisateur anonyme
 
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
0
Réponse 17 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
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)
0
Réponse 18 / 22
Utilisateur anonyme
 
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
0
Réponse 19 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Réponse 20 / 22
damlaine Messages postés 18 Date d'inscription   Statut Membre Dernière intervention  
 
Je comprend parfaitement ton code merci d'ailleurs mais il m'affiche à nouveau le meme message. Je comprend pas du tout pourquoi
0