Extraction de valeurs sous conditions
Bonsoir à tous,
Pour extraire les valeurs numériques devant les L3-xxxx depuis un fichier texte, j'utilise le code suivant :
Sub OuvreFichL3()
Dim B$(), bb$(4), Item As Object
Dim i As Byte, LastLg As Long
Dim Name As String
Dim NC As Boolean
Dim tabNC()
Dim Ligne As Long
Dim Start, EndStart
Start = Timer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'On Error Resume Next
reponse = Application.GetOpenFilename _
("All Files (*.*),*.*")
If reponse = False Then Exit Sub
Canal = FreeFile
Open reponse For Input As #Canal
[A1].Value = "Numéro"
Range("A2:A" & [A65000].End(xlUp).Row + 1).ClearContents
Range("A2:A" & [A65000].End(xlUp).Row + 1).Interior.Pattern = xlNone
Do While Not EOF(Canal)
Line Input #Canal, a$
If Len(Trim(a$)) > 0 Then '-- Si la ligne est non vide
If InStr(1, a$, "ABN") > 0 Then
'-- Lire une nouvelle ligne
Line Input #Canal, a$
' Si la ligne contient la chaine WO en passe
If InStr(1, a$, " WO") > 1 Then
Line Input #Canal, a$
Continue = True
Else
Continue = True
End If
Do While Continue
Debug.Print a$
B$ = Split(Trim(a$), " ")
i = 0: j = 0
' On parcours le tableau résultant
For Each Item In B$
' Si l'élément du tableau est non vide
If Len(Trim(Item)) > 0 Then
If InStr(1, Item, "L3-") > 0 And _
InStr(1, Item, "&") = 0 Then
' Si la ligne suivante contient la chaine CL
' on ne comptabilise pas la l'élément en cours
Line Input #Canal, a$ 'ICI on devra relire cette ligne si elle ne contient pas de CL ???
If InStr(1, a$, "CL") = 0 Then
li = Split(Item, "-")
'-- Ecriture dans le feuille
LastLg = [A65000].End(xlUp).Row + 1
Cells(LastLg, 1) = li(1)
Rem.
'-- Ecriture dans un tableau
'---
Rem.
i = i + 1
End If
End If
End If
j = j + 1
Next Item
End If
' Lecture d'une nouvelle ligne
Line Input #Canal, a$
If InStr(1, a$, "WO") > 1 Then
Line Input #Canal, a$
ElseIf InStr(1, a$, "END") > 1 Then
Continue = False
End If
Loop
End If
End If
Loop
Close #Canal
Range("A1:A65000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
MsgBox "Sort complete.", vbInformation
'On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
[B10] = Timer - Start
MsgBox "Temp d'exécution" & [B10]
End SubMais, en voulant passer toute ligne contenant un "L3" et juste au dessous une ligne qui contient un "CL" et ne rien extraire, je bloque pour trouver une solution.
Merci d'avance.
Bonsoir
Les règles pour récupérer le nombre ne sont pas clairement définies
A voir
Bonsoir Banzai64,
Pour les premiers tests sur le fichier texte exemple, ça marche.
Merci.
Je vais faire des tests sur le fichier texte original et voir ce que ça donne.
Les règles pour récupérer le nombre ne sont pas clairement définies
Il me faut extraire tous nombre xxx devant le L3-xxxx dans les lignes qui ne sont pas suivis d'une ligne contenant un "CL", et ignorer le reste des lignes que contienne le fichier texte.
Voila !
Bonsoir à tous,
Déjà il y a une erreur de structure dans tes boucles.
Le Loop n'est pas aligné avec le Do...
Tu aurais un endif en trop (?)
Le cas avec CL qui apparait sur la page suivante n'est pas traité (et est absent du fichier texte d'ailleurs).
Est-ce un cas réellement impossible ?
Dans le doute je traite.
Il peut être présent sur plusieurs lignes consécutives (au cas ou..., on peut encore alléger le code si ce n'est jamais le cas)).
Sinon, à voir le fichier texte, j'ai l'impression que L3-xxxx et CL sont toujours le premier champ de la ligne.
Si c'est le cas tu peux considérablement simplifier.
La boucle deviendrait :
Do While Not EOF(Canal)
Line Input #Canal, a$
If Not (InStr(1, a$, "ABN") > 0 Or InStr(1, a$, " WO") > 1) Then
Item = Split(Trim(a$), " ")(0)
If InStr(1, Item, "L3-") > 0 And InStr(1, Item, "&") = 0 Then
cptLig = cptLig + 1
Cells(cptLig, 1) = Split(Split(Trim(a$), " ")(0), "-")(1)
CL = False
ElseIf InStr(1, Item, "CL") > 0 And Not CL Then
Cells(cptLig, 1) = ""
cptLig = cptLig - 1
CL = True
End If
End If
LoopMais comme dit Banzai, les règles ne sont pas clairement établies. Je me suis basé sur les commentaires. Je suis peut-être à coté de la plaque avec toutes ces supposition (?)
Je ne traite pas le cas du END en supposant que ton listing s’arrête là. A ajouter éventuellement si tu peux avoir beaucoup de lignes en dessous.
Par curiosité, ton listing est issu de quel système ?
eric
PS: je suis parti du fichier de Banzai et j'ai oublié de changer la macro sur le bouton.
C'est la macro du module1 que j'ai modifiée et qu'il faut tester.
Bonjour
apt a écrit :Il me faut extraire tous nombre xxx devant le L3-xxxx
Devant ou après ?
La macro extrait les nombres situés après L3-
Ai-je tout compris ?
Bonjour eriic, Banzai64,
eriiic a écrit :Le cas avec "CL" qui apparait sur la page suivante n'est pas traité (et est absent du fichier texte d'ailleurs).
Le "CL" vient toujours seul dans une ligne au dessous de "BL" et parfois on peut "BL", "CL" et "AL"
Il peut être présent sur plusieurs lignes consécutives (au cas ou..., on peut encore alléger le code si ce n'est jamais le cas)).
Dans ce fichier texte les lignes qui se suivent viennent sous la forme :
L3-5 BC ML CN O'0C
L3-13 BC ML CN O'0C
L3-123 BC ML CN O'0C
L3-158 BC ML CN O'0C
L3-6556 BC ML CN O'0C
CL
L3-6557 BC ML CN O'0C
CL
L3-6558 BC ML CN O'0C
L3-6559 BC ML CN O'0C
CL
AL
L3-6560 BC ML CN O'0C
CL
AL
Je ne devrais prendre que les numéros après les L3 avec l’état "ML" seulement
Sinon, à voir le fichier texte, j'ai l'impression que L3-xxxx et CL sont toujours le premier champ de la ligne.
Les lignes à traiter commencent toujours par L3-xxxx et juste au dessous en pourra trouver des lignes avec "CL" seulement.
Si c'est le cas tu peux considérablement simplifier.
J'ai ajouté une ligne de code pour éviter les lignes vides.
If Len(Trim(a$)) > 0 Then '-- Si la ligne est non videMais comme dit Banzai, les règles ne sont pas clairement établies
Je ne devrais prendre que les numéros xxxx après les L3-xxxxx avec l’état "ML" seulement.
je ne traite pas le cas du END en supposant que ton listing s’arrête là. A ajouter éventuellement si tu peux avoir beaucoup de lignes en dessous.
Dans ce fichier il y a seulement un seul END
Par curiosité, ton listing est issu de quel système ?
Système de gestion téléphonique.
Banzai64 a écrit :Devant ou après ?
Ai-je tout compris ?
Oui bien sur
Bonjour,
Le "CL" vient toujours seul dans une ligne au dessous de "BL" et parfois on peut "BL", "CL" et "AL"Ca ne répond pas à la question "et pourquoi pas après un saut de page ?"
Par exemple :
......
L3-11097 BC ML CN O'0C
WO PAGE 18
CL
....
J'ai ajouté une ligne de code pour éviter les lignes vides.Dans mon code elle me parait inutile puisque les chaine servant à se caler n'y sont pas par définition.
Dans ce fichier il y a seulement un seul END
Oui, mais autant de tests par ligne... Autant l'éviter si ça ne sert à rien
Système de gestion téléphonique.Ca ressemblait trop à des listings que je connais (AXE10)
eric
Bonsoir eriiic,
eriiic a écrit :Ca ne répond pas à la question "et pourquoi pas après un saut de page ?"
Par exemple :
......
L3-11097 BC ML CN O'0C
WO PAGE 18
CL
....
Tu as raison, les marques de page viennent souvent pour couper un listing, comme tu le sais puisque tu es habitué
Dans mon code elle me parait inutile puisque les chaine servant à se caler n'y sont pas par définition.
On trouve les vides dans les premières lignes d'un fichier texte.
Mais, j'aimerais savoir la signification de ceci :
les chaine servant à se caler n'y sont pas par définition
Oui, mais autant de tests par ligne... Autant l'éviter si ça ne sert à rien
Dans ce cas de figure, les tests sont inutiles à l'inverse d'autre listings similaires ou on peut trouver plusieurs END selon les listings présents dans le fichier texte.
Ca ressemblait trop à des listings que je connais (AXE10)
Tu y es encore ?
Bonsoir,
On trouve les vides dans les premières lignes d'un fichier texte.
Mais, j'aimerais savoir la signification de ceci :
les chaine servant à se caler n'y sont pas par définitionJe voulais dire que pour chaque ligne traitée on recherche la chaine caractéristique : L3, WO qui par définition ne s'y trouvent pas si la ligne est vide.
Mais effectivement j'en ai ajouté une, et instr() n'aime pas. Je retire ce que j'ai dit.
on peut trouver plusieurs END selon les listings
ok, à traiter donc
Je jetterais un oeil demain
Pour le reste c'est en MP.
eric
Bonsoir,
Voila un nouveau code avec mise dans un tableau TbNC :
Sub OuvreFichTab()
Dim Tablo, TbNC()
Dim Reponse As String
Dim Canal As Integer
Dim LigneEnCours As String
Dim NombreEnCours As String
Dim i As Integer
Dim Start, EndStart
Start = Timer
With Columns("A")
.ClearContents
.Interior.Pattern = xlNone
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Reponse = Application.GetOpenFilename _
("All Files (*.*),*.*")
If Reponse = "Faux" Then Exit Sub
Canal = FreeFile
Open Reponse For Input As #Canal
[A1].Value = "Numéro"
Do While Not EOF(Canal)
Line Input #Canal, LigneEnCours
If Len(Trim(LigneEnCours)) > 0 Then '-- Si la ligne est non vide
LigneEnCours = Trim(LigneEnCours)
Debug.Print "LigneEnCours = " & LigneEnCours
If InStr(1, LigneEnCours, "L3-") > 0 Then
If NombreEnCours <> "" Then
i = i + 1: MsgBox " i : " & i
ReDim Preserve TbNC(1 To i, 1 To 1)
TbNC(i, 1) = NombreEnCours
Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(i, 1)
End If
NombreEnCours = ""
Tablo = Split(LigneEnCours, " ")
NombreEnCours = Split(Tablo(0), "-")(1)
ElseIf InStr(1, LigneEnCours, "CL") > 0 Then
NombreEnCours = ""
Else
If NombreEnCours <> "" Then
i = i + 1: MsgBox " i : " & i
ReDim Preserve TbNC(1 To i, 1 To 1)
TbNC(i, 1) = NombreEnCours
Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(i, 1)
End If
NombreEnCours = ""
End If
End If
Loop
Close #Canal
Range("A1").Resize(i, 1) = TbNC
Range("A1:A65000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
MsgBox "Sort complete.", vbInformation
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
[B10] = Timer - Start
MsgBox "Temp d'exécution : " & [B10]
End SubSeulement j'ai une erreur :
L'indice n'appartient pas à la selection
Dans la ligne :
ReDim Preserve TbNC(1 To i, 1 To 1)Bonsoir
Tu ne peux que modifier la dernière dimension d'un tableau
Il faut inverser ton tableau
Bonsoir Banzai64,
J'ai inversé mon tableau :
ReDim Preserve TbNC(1, i)Mais, en voulant afficher le tableau dans la colonne A, je n'obtiens rien :
Range("A2").Resize(UBound(TbNC), 1) = Application.Transpose(TbNC)Bonjour
Essaies
Range("A2").Resize(UBound(TbNC,2), 1) = Application.Transpose(TbNC)Désolé, ça ne donne rien (Juste la chaine "Numéro" en A1) !
Et même résultat avec :
Range("A2").Resize(i, 1) = Application.Transpose(TbNC)Bonjour
Si cela fonctionne
Sub OuvreFichTab()
Dim Tablo, TbNC()
Dim Reponse As String
Dim Canal As Integer
Dim LigneEnCours As String
Dim NombreEnCours As String
Dim i As Integer
Dim Start, EndStart
With Columns("A")
.ClearContents
.Interior.Pattern = xlNone
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Reponse = Application.GetOpenFilename _
("All Files (*.*),*.*")
If Reponse = "Faux" Then Exit Sub
Start = Timer
Canal = FreeFile
Open Reponse For Input As #Canal
[A1].Value = "Numéro"
Do While Not EOF(Canal)
Line Input #Canal, LigneEnCours
If Len(Trim(LigneEnCours)) > 0 Then '-- Si la ligne est non vide
LigneEnCours = Trim(LigneEnCours)
'Debug.Print "LigneEnCours = " & LigneEnCours
If InStr(1, LigneEnCours, "L3-") > 0 Then
If NombreEnCours <> "" Then
i = i + 1 ': MsgBox " i : " & i
ReDim Preserve TbNC(1 To 1, 1 To i)
TbNC(1, i) = NombreEnCours
'Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(i, 1)
End If
NombreEnCours = ""
Tablo = Split(LigneEnCours, " ")
NombreEnCours = Split(Tablo(0), "-")(1)
ElseIf InStr(1, LigneEnCours, "CL") > 0 Then
NombreEnCours = ""
Else
If NombreEnCours <> "" Then
i = i + 1 ': MsgBox " i : " & i
ReDim Preserve TbNC(1 To 1, 1 To i)
TbNC(1, i) = NombreEnCours
'Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(i, 1)
End If
NombreEnCours = ""
End If
End If
Loop
Close #Canal
Range("A1").Resize(UBound(TbNC, 2), 1) = Application.Transpose(TbNC)
'Range("A1").Resize(i, 1) = TbNC
Range("A1:A65000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
'MsgBox "Sort complete.", vbInformation
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
[B10] = Timer - Start
MsgBox "Temp d'exécution : " & [B10]
End SubBonjour,
toujours pas de résultat.
Bonjour
Tu aurais du aussi essayer le code
Modifies tes Redim
ReDim Preserve TbNC(1 To 1, 1 To i)Ne demandes pas pourquoi, c'est comme ça
Bonjour,
Merci Banzai64. Ca Marche.
La question qui reste sans réponse :
Pourquoi les deux définitions sont justes, et il n'y a que la 2eme qui donne le résultat ?
Bonjour
Pas sur mais c'est peut-être en fonction de la base du tableau
Option Base 1dans ce cas tu forces le tableau en base 1
ReDim Preserve TbNC(1 To 1, 1 To i)Dans ce cas le tableau est en base 0
ReDim Preserve TbNC(1, i)Mais comme je te le dis je n'en suis pas sur
Mais juste pour voir testes
Range("A2").Resize(UBound(TbNC, 2) + 1, 2) = Application.Transpose(TbNC)Bonsoir,
Avec :
ReDim Preserve TbNC(1 To 1, 1 To i)et
Range("A2").Resize(UBound(TbNC, 2) + 1, 2) = Application.Transpose(TbNC)Ca donne :
Numéro
13 13
16 16
11096 11096
11097 11097
11110 11110
11117 11117
#N/A #N/A
Avec :
ReDim Preserve TbNC(1, i)Le tableau TbNC est transposé en colonne B !