Sujet Précédent Sujet Suivant

Boucle for next imbriquées

Résolu
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015 - 11 févr. 2015 à 00:18
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015 - 12 févr. 2015 à 13:08
Bonjour,
je dois rechercher dans un tableau des variables "string"
je dois comparer chacune à des variables string d'un autre tableau
pour trouver celles qui sont identiques
et ensuite si elle sont identique
effectuer un traitement
j'ai donc écris : 
for I1 = 1 to N1Max
     for I2=1 to N2Max
          if chaine(I1)=chaine(I2) then
               bla bla
          end if
     next I2
next I1

le problème est que N1Max et N2Max sont grands
et cela met un temps fou ....
quelqu'un connaîtrai-t-il une technique plus rapide que ces boucles??
merci beaucoup d'avance.
bonne programmation à tous
Claude

13 réponses

Réponse 1 / 13
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 11/02/2015 à 07:05
Bonjour,
1) Sous quoi développes-tu ? (VB.Net ? VB6 ? VBA ?). Tu es ici dans le forum général Visual Basic et non dans le sous-forum correspondant à un langage de développement.
Ce point est d'autant plus important que, si tu développes sous VBA/Excel, une question vient immédiatement à l'esprit (et elle est pour l'instant une inconnue totale) : comment sont "dressés" tes deux "tableaux" ? A partir de quoi ?

2) tu nous parles de deux tableaux et nous n'en voyons qu'un seul dans le code que tu montres.

3) veux-tu bien s'il te plait nous montrer ton code, tel qu'écrit (fais un copier/coller) et non une copie manuelle de ton code. L'expérience nous a souvent montré que ces "copies manuelles" conduisaient à des erreurs importantes.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
0
Whismeril Messages postés 19035 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 6 mai 2024 656
11 févr. 2015 à 10:17
Bonjour, pour compléter ce que dit Uc, si c'est du VB.net, il y a une méthode Linq pour comparer deux collections.

Donc la version est primordiale pour te répondre.
0
Réponse 2 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
11 févr. 2015 à 11:56
Bonjour,
Tout d'abord, MERCI pour ta réponse
je vais essayer de t'apporter les précisions
- je développe sous VBA excel.

-Les 2 tableaux:
le premier : LaCol__AP est dressé à partir d'un fichier NomFichier10 qui est un fichier de string
NomFichier10 a été créé et rempli dans une autre Sub
je t'es mis le Open pour te préciser le type de fichier

le deuxième : LesCasPourDateFutur a été créé par un Dim
(voir le code) et rempli à partir de concaténations dans une autre Sub, le résultat étant un tableau de string.

Ici MaxRienCas est variable mais toujours grand (plus que la limite des Integer-)

j'espère être assez clair
très très cordialement

Claude

ps: je ne sais pas comment transferer dans le sous forum correspondant à VBA/Excel 

Dim LaCol__AP() As String<code>
Dim LesCasPourDateFutur(NbCasPossible)  As String
Dim MaxRienCas As Long
Dim NbEnregistrementsLusàlafois As Long
Dim intFic2 'je ne sais pas si byte, integer ou long donc je laisse excel choisir...
Dim intFic10 'idem
Dim RienL As Long

'*******pour définir dans une autre Sub on a:
intFic10 = FreeFile
Open NomFichier10 For Input As intFic10
'*******
Sub Lire1Enregistrement()
On Error GoTo Erreur99

Do While Not EOF(intFic2)
    Input #intFic2, S_NbEnregistrementsLusàlafois
    NbEnregistrementsLusàlafois = Val(S_NbEnregistrementsLusàlafois)
    
    ReDim LaCol__AP(NbEnregistrementsLusàlafois)
    ReDim LaCol__AQ(NbEnregistrementsLusàlafois) 'sont des Integer
    ReDim LesCol__ARàCol__AZ(NbEnregistrementsLusàlafois, Col_BC - Col_AU + 1) 'Sont des Single
    ReDim LesCol__BBàCol__CS(NbEnregistrementsLusàlafois, Col_CV - Col_BE + 1) 'Sont des Byte
    
    'NbEnregistrementsLusàlafois et MaxRienCas sont des Long car >37000
    For RienL = 1 To NbEnregistrementsLusàlafois
        Input #intFic10, LaCol__AP(RienL)
        If PremièreRecherche Then
                For RienCas = 1 To MaxRienCas
                    If LesCasPourDateFutur(RienCas) = LaCol__AP(RienL) Then
                        CestTrouvé 'n'est qu'un affichage sur une feuille excel (pas fréquent)
                    End If
                Next RienCas
         End If
    Next RienL
Loop
Exit Sub

Erreur99:
RienL = RienL 'pour juste mettre un point d'arret pour comprendre une éventuelle erreur
Stop

Resume
End Sub
0
Réponse 3 / 13
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
11 févr. 2015 à 12:33
Je commence donc par rediriger vers le sous-forum adéquat (VBA)
Je reviens après ma sieste.
0
Réponse 4 / 13
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
11 févr. 2015 à 17:39
Ces "bouts" de code, sans rien d'autre (les procédures, depuis Sub jusqu'à End Sub) ne nous permettent que de "deviner", avec le risque de mal deviner !
Montre s'il te plait les procédures EN ENTIER

Montre également comment a été écrit le fichier NomFichier10

Montre enfin la sub (en entier) qui remplit le fichier LesCasPourDateFutur
0

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

Posez votre question
Réponse 5 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
11 févr. 2015 à 22:53
Bonsoir,
Voilà donc le code qui montre comment a été écrit le fichier NomFichier10
il s'agit d'un programme indépendant de la lecture 

Option Explicit
Option Base 1

Const col_A = 1: Const col_B = 2: Const Col_C = 3: Const Col_D = 4: Const Col_E = 5: Const Col_F = 6
Const col_G = 7: Const Col_H = 8: Const Col_I = 9: Const Col_J = 10: Const Col_K = 11: Const Col_L = 12
Const Col_M = 13: Const col_N = 14: Const Col_O = 15: Const Col_P = 16: Const Col_Q = 17: Const Col_R = 18
Const Col_S = 19: Const col_T = 20: Const Col_U = 21: Const Col_V = 22: Const Col_W = 23: Const Col_X = 24: Const Col_Y = 25
Const col_Z = 26: Const Col_AP = 26 + 16: Const Col_MS = 13 * 26 + 19

Dim NblT As Long

Dim NomFich As String
Dim NomFichier10 As String
Dim NomFichier2 As String
Dim Repertoire As String

Dim intFic10 ' as ??? quel type pour un fichier??
Dim intFic2

Dim TraitementA As Byte
Dim TraitementB As Byte
Dim TraitementC As Byte
Dim TraitementD As Byte
Dim TraitementE As Byte

Dim LaCol__AP() As String
Dim LaCol__APSve() As String

Dim LaCol__AP1() As String
Dim LaCol__AP1Sve() As String

Dim LaCol__AP2() As String
Dim LaCol__AP2Sve() As String

Dim LaCol__AP3() As String
Dim LaCol__AP3Sve() As String

Dim LaCol__AP4() As String
Dim LaCol__AP4Sve() As String

Dim LaCol__AP5() As String
Dim LaCol__AP5Sve() As String

Dim TempLaCol__AP() As String

Dim RienC As Integer
Dim RienL As Long
Dim RienL1 As Long

Dim NbLignes As Long

Dim Longueur
Dim rang As Byte
Dim NouvChaine As String

Sub OuvreLesFichiersPourEcrire()
On Error Resume Next
NomFich = "Calcul 3 " + " à la Date du " + _
str(Day(Date)) + "-" + str(Month(Date)) + "-" + str(Year(Date)) + "-" + str(Hour(Time)) + "H -" + str(Minute(Time)) + "Mn"
NomFichier10 = "Les AP" + NomFich
NomFichier2 = "NbLigneDeChaquePage " + NomFich
Repertoire = "C:\Users\Claude\Documents\"

ChDir Repertoire
Close
Kill NomFichier10
Kill NomFichier2

intFic10 = FreeFile
Open NomFichier10 For Append As intFic10   ' Len = 89

intFic2 = FreeFile
Open NomFichier2 For Append As intFic2

End Sub

Sub FermeLesFichiers()
Close
End Sub

Sub Initialisation()
' NbLignes est le nombre d'elements traités
For RienL = 8 To 999999
    If Worksheets("Les  X - Y").Cells(RienL, Col_J) = Empty Then
    'Worksheets("Les  X - Y").Cells(RienL, Col_J) contient des dates de format "jj/mm/aaaa"
        NbLignes = RienL - 1
        Exit For
    End If
Next RienL
ReDim LaCol__AP(1 To NbLignes)
End Sub

Sub Cinq_B5()
Initialisation 'pour rendre indépendant de : Sub DebutPresentation()
OuvreLesFichiersPourEcrire
Traitement_B5A
FermeLesFichiers
MsgBox "Fini Ecrire"
End Sub

Sub Tableau_B5()
Dim Rang1 As Byte
Dim Rang3 As Byte

ReDim LaCol__AP(1 To NbLignes)

ReDim LaCol__AP1(1 To NbLignes)
ReDim LaCol__AP2(1 To NbLignes)
ReDim LaCol__AP3(1 To NbLignes)
ReDim LaCol__AP4(1 To NbLignes)
ReDim LaCol__AP5(1 To NbLignes)

ReDim LaCol__AP1Sve(1 To NbLignes)
ReDim LaCol__AP2Sve(1 To NbLignes)
ReDim LaCol__AP3Sve(1 To NbLignes)
ReDim LaCol__AP4Sve(1 To NbLignes)
ReDim LaCol__AP5Sve(1 To NbLignes)

ReDim LaCol__APSve(1 To NbLignes)

With Worksheets("Les  X - Y") 'Ici Source
    Rang1 = InStr(1, .Cells(22, Col_MS), "-")
    Rang3 = InStrRev(.Cells(22, Col_MS), "-", -1)
    Longueur = Len(.Cells(22, Col_MS))
    For RienL = 22 To NbLignes
        LaCol__AP(RienL) = .Cells(RienL, Col_MS)
        LaCol__AP1(RienL) = Left(LaCol__AP(RienL), Rang1 - 1)
        LaCol__AP2(RienL) = Mid(LaCol__AP(RienL), Len(LaCol__AP1(RienL)) + 2, Len(LaCol__AP1(RienL)))
        LaCol__AP3(RienL) = Mid(LaCol__AP(RienL), 2 * Len(LaCol__AP1(RienL)) + 3, Len(LaCol__AP1(RienL))) 

        LaCol__AP4(RienL) = Mid(LaCol__AP(RienL), 3 * Len(LaCol__AP1(RienL)) + 4, Len(LaCol__AP1(RienL)))
        LaCol__AP5(RienL) = Right(LaCol__AP(RienL), Longueur - Rang3)
    Next RienL
End With

LaCol__APSve = LaCol__AP
LaCol__AP1Sve = LaCol__AP1
LaCol__AP2Sve = LaCol__AP2
LaCol__AP3Sve = LaCol__AP3
LaCol__AP4Sve = LaCol__AP4
LaCol__AP5Sve = LaCol__AP5

End Sub

Sub Traitement_B5A()
On Error GoTo Erreur1a
    Tableau_B5

For TraitementA = 0 To 7 '7
    
    For RienL = 22 To UBound(LaCol__AP1)
        LaCol__AP1(RienL) = LaCol__AP1Sve(RienL)
    Next RienL

    Select Case TraitementA
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
            For RienL = 22 To UBound(LaCol__AP1)
                LaCol__AP1(RienL) = Left(LaCol__AP1(RienL), rang - 1) & NouvChaine & Right(LaCol__AP1(RienL), Len(LaCol__AP1(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5B
            
        Case 0
            Traitement_B5B
       
    End Select
   
Next TraitementA
Exit Sub
Erreur1a:
RienL = RienL
Stop: Resume
End Sub

Sub Traitement_B5B()
  '  Tableau_B5 ???
On Error GoTo Erreur1b
For TraitementB = 0 To 7 '7
    
    For RienL = 22 To UBound(LaCol__AP2)
        LaCol__AP2(RienL) = LaCol__AP2Sve(RienL)
    Next RienL

    Select Case TraitementB
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
            For RienL = 22 To UBound(LaCol__AP2)
                LaCol__AP2(RienL) = Left(LaCol__AP2(RienL), rang - 1) & NouvChaine & Right(LaCol__AP2(RienL), Len(LaCol__AP2(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5C
            
        Case 0
            Traitement_B5C
       
    End Select
   '
   
Next TraitementB
Exit Sub
Erreur1b:
RienL = RienL
Stop: Resume
End Sub

Sub Traitement_B5C()
On Error GoTo Erreur1c

For TraitementC = 0 To 7 '7
    For RienL = 22 To UBound(LaCol__AP3)
        LaCol__AP3(RienL) = LaCol__AP3Sve(RienL)
    Next RienL

    Select Case TraitementC
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
            For RienL = 22 To UBound(LaCol__AP3)
                LaCol__AP3(RienL) = Left(LaCol__AP3(RienL), rang - 1) & NouvChaine & Right(LaCol__AP3(RienL), Len(LaCol__AP3(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5D
            
        Case 0
            Traitement_B5D
       
    End Select
Next TraitementC
Exit Sub
Erreur1c:
RienL = RienL
Stop: Resume

End Sub

Sub Traitement_B5D()
On Error GoTo Erreur1d

For TraitementD = 0 To 7 '7
    For RienL = 22 To UBound(LaCol__AP4)
        LaCol__AP4(RienL) = LaCol__AP4Sve(RienL)
    Next RienL

    Select Case TraitementD
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
            For RienL = 22 To UBound(LaCol__AP4)
                LaCol__AP4(RienL) = Left(LaCol__AP4(RienL), rang - 1) & NouvChaine & Right(LaCol__AP4(RienL), Len(LaCol__AP4(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            Traitement_B5E
            
        Case 0
            Traitement_B5E
       
    End Select
Next TraitementD
Exit Sub
Erreur1d:
RienL = RienL
Stop: Resume

End Sub

Sub Traitement_B5E()
On Error GoTo Erreur12

For TraitementE = 0 To 7 '7
  RienL = RienL
    ReDim LaCol__AP(1 To NbLignes)

    For RienL = 22 To UBound(LaCol__AP5)
        LaCol__AP5(RienL) = LaCol__AP5Sve(RienL)
    Next RienL
    
    Select Case TraitementE
        Case 1
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
        Case 2
            rang = 3
            NouvChaine = "**"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
        Case 3
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
        Case 4
            rang = 1
            NouvChaine = "*/**"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
        Case 5
            rang = 3
            NouvChaine = "**/*"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
         Case 6
            rang = 1
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            rang = 6
            NouvChaine = "*"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
       Case 7
            rang = 1
            NouvChaine = "*/**/*/*"
            For RienL = 22 To UBound(LaCol__AP5)
                LaCol__AP5(RienL) = Left(LaCol__AP5(RienL), rang - 1) & NouvChaine & Right(LaCol__AP5(RienL), Len(LaCol__AP5(RienL)) - rang - (Len(NouvChaine) - 1))
            Next RienL
            
        Case Else
    End Select
    
    'voila on a les portions LaCol__APx que l'"on recolle pour faire LaCol__AP Qui sera affichée (LaCol__AP a auparavent été Redim dans cette Sub qui est la derniere du Traitement des bouts
    
            For RienL = 22 To UBound(LaCol__AP5)  '=NbLignes
                LaCol__AP(RienL) = LaCol__AP1(RienL) + "-" + LaCol__AP2(RienL) + "-" + LaCol__AP3(RienL) + "-" + LaCol__AP4(RienL) + "-" + LaCol__AP5(RienL)

'LaCol__AP(RienL) est de la forme : "V/PB/G/M:2,0:0,50-R/PB/P/M:2,0:0,50-V/PB/P/M:2,0:0,50-R/DD/G/M:2,0:0,50-V/CH/G/M:2,0:0,50"
' la longueur de la chaine est CONSTANTE
'avec des variations qui sont des caractères V, P G M differents et des 2,0 ou 0,50 qui changent
'autre variation : les lettres sont remplacées par des "*"
        Write #intFic10, LaCol__AP(RienL)
        Write #intFic2, NbLignes
    
            Next RienL
    
Next TraitementE

Exit Sub
Erreur12:
RienL = RienL
Stop: Resume
End Sub
0
Réponse 6 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
11 févr. 2015 à 22:55
voila la suite...c'est a dire la lecture et la sub (en entier) qui remplit le fichier LesCasPourDateFutur
merci beaucoup de ta patience et de ton aide
Claude
0
Réponse 7 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
11 févr. 2015 à 23:59 
Option Explicit
Option Base 1

Const col_A = 1: Const col_B = 2: Const Col_C = 3: Const Col_D = 4: Const Col_E = 5: Const Col_F = 6
Const col_G = 7: Const Col_H = 8: Const Col_I = 9: Const Col_J = 10: Const Col_K = 11: Const Col_L = 12
Const Col_M = 13: Const col_N = 14: Const Col_O = 15: Const Col_P = 16: Const Col_Q = 17: Const Col_R = 18
Const Col_S = 19: Const col_T = 20: Const Col_U = 21: Const Col_V = 22: Const Col_W = 23: Const Col_X = 24: Const Col_Y = 25
Const col_Z = 26

Const Col_AA = 26 + 1: Const Col_AB = 26 + 2: Const Col_AC = 26 + 3: Const Col_AD = 26 + 4: Const Col_AE = 26 + 5: Const Col_AF = 26 + 6
Const Col_AG = 26 + 7: Const Col_AH = 26 + 8: Const Col_AI = 26 + 9: Const Col_AJ = 26 + 10: Const Col_AK = 26 + 11: Const Col_AL = 26 + 12
Const Col_AM = 26 + 13: Const Col_AN = 26 + 14: Const Col_AO = 26 + 15: Const Col_AP = 26 + 16: Const Col_AQ = 26 + 17: Const Col_AR = 26 + 18
Const Col_AS = 26 + 19: Const Col_AT = 26 + 20: Const Col_AU = 26 + 21: Const Col_AV = 26 + 22: Const Col_AW = 26 + 23: Const Col_AX = 26 + 24
 Const Col_AY = 26 + 25: Const col_AZ = 26 + 26

Dim NbEnregistrementsLusàlafois As Long
Dim S_NbEnregistrementsLusàlafois As String

Dim Repertoire As String
Dim NomFichier1 As String
Dim NomFichier10 As String
Dim NomFichier2 As String
Dim intFic2
Dim intFic10

Dim TraitementA As Byte
Dim TraitementB As Byte
Dim TraitementC As Byte
Dim TraitementD As Byte
Dim TraitementE As Byte
Dim LaCol__AP() As String

Dim RienC As Integer
Dim RienL As Long
Dim RienLResult As Long

Dim NbLignes As Long
Dim Cejour
Dim CeMois
Dim CetteAnnée
Dim CetteDate As Date

' futur
Const NbCasPossible = 32768 * 20
Const PremiereDonnéeFuturSignificative = 22
Dim FinLigneEltsFutur As Integer
Dim LigneDateFutur As Integer
Dim LesCasPourDateFutur(NbCasPossible)  As String
Dim RienCas As Long
Dim MaxRienCas As Long
Dim CasBase1 As String
Dim CasBase2 As String
Dim CasBase3 As String
Dim CasBase4 As String
Dim CasBase5 As String
Dim ExCasBase1 As String
Dim ExCasBase2 As String
Dim ExCasBase3 As String
Dim ExCasBase4 As String
Dim ExCasBase5 As String

Dim rang As Byte
Dim NouvChaine As String

Sub ChoisirFichier()
    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
    Dim FichierChoisiNomComplet As String
    Dim fs, f
    Dim SelectedItem
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .InitialFileName = "C:\Users\Claude\Documents\"
        If .Show = -1 Then
            For Each SelectedItem In .SelectedItems
                FichierChoisiNomComplet = .SelectedItems.Item(1)
            Next SelectedItem
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFile(FichierChoisiNomComplet)
            NomFichier1 = f.Name
            For Each vrtSelectedItem In .SelectedItems
                Repertoire = Left(vrtSelectedItem, InStrRev(vrtSelectedItem, "\") - 1)
            Next vrtSelectedItem
        Else
        End If
    End With
    Set fd = Nothing
End Sub
Sub OuvreLesFichiersPourLire()
On Error Resume Next
ChoisirFichier

NomFichier10 = "Les AP" + Left(Right(NomFichier1, Len(NomFichier1) - 4), Len(Right(NomFichier1, Len(NomFichier1) - 4)) - 4)
NomFichier2 = "NbLigneDeChaquePage " + Left(Right(NomFichier1, Len(NomFichier1) - 4), Len(Right(NomFichier1, Len(NomFichier1) - 4)) - 4)

ChDir Repertoire
Close
intFic2 = FreeFile
Open NomFichier2 For Input As intFic2

intFic10 = FreeFile
Open NomFichier10 For Input As intFic10
End Sub
Sub FermeLesFichiers()
Close
End Sub
Sub Initialisation()
For RienL = 8 To 999999
    If Worksheets("Les  X - Y").Cells(RienL, Col_J) = Empty Then
        NbLignes = RienL - 1
        Exit For
    End If
Next RienL

ReDim LaCol__AP(1 To NbLignes)
End Sub
Sub Cinq_B5_LireVirtuel()
Initialisation
OuvreLesFichiersPourLire
ReDim LaCol__AP(1 To NbLignes)
Lire1Enregistrement
FermeLesFichiers
MsgBox "Fini Lire"
End Sub

Sub Lire1Enregistrement()
On Error GoTo Erreur99
Do While Not EOF(intFic2)
Input #intFic2, S_NbEnregistrementsLusàlafois
NbEnregistrementsLusàlafois = Val(S_NbEnregistrementsLusàlafois)
ReDim LaCol__AP(NbEnregistrementsLusàlafois)

For RienL = 1 To NbEnregistrementsLusàlafois
    Input #intFic10, LaCol__AP(RienL)
    For RienCas = 1 To MaxRienCas
        If LesCasPourDateFutur(RienCas) = LaCol__AP(RienL) Then
            CestTrouvé
        End If
    Next RienCas
Next RienL
Loop
Exit Sub
Erreur99:
RienL = RienL
Stop
Resume
End Sub
Sub CestTrouvé()
    RienLResult = RienLResult + 1
    Worksheets("Elts Results").Cells(RienLResult, Col_AS) = LaCol__AP(RienL)
End Sub
Sub DernierJour()
For RienL = 8 To 999999
    If Worksheets("Elts Futur").Cells(RienL, Col_J) = Empty Then
        FinLigneEltsFutur = RienL - 1
        Exit For
    End If
Next RienL
End Sub
Sub QuelleDate()
Cejour = Worksheets("Les  X - Y").Cells(23, col_B)
CeMois = Worksheets("Les  X - Y").Cells(24, col_B)
CetteAnnée = Worksheets("Les  X - Y").Cells(25, col_B)
CetteDate = DateSerial(CetteAnnée, CeMois, Cejour)
LigneDateFutur = 0
With Worksheets("Elts Futur")
    For RienL = PremiereDonnéeFuturSignificative + 1 To FinLigneEltsFutur
        If CetteDate = .Cells(RienL, Col_J) Then
            LigneDateFutur = RienL
            Exit For
        End If
    Next RienL
End With
End Sub
Sub ListeDesCasParPage()
With Worksheets("Elts Futur")
    CasBase1 = .Cells(LigneDateFutur, Col_AP).Value
    CasBase2 = .Cells(LigneDateFutur - 1, Col_AP).Value
    CasBase3 = .Cells(LigneDateFutur - 2, Col_AP).Value
    CasBase4 = .Cells(LigneDateFutur - 3, Col_AP).Value
    CasBase5 = .Cells(LigneDateFutur - 4, Col_AP).Value
    ExCasBase1 = CasBase1
    ExCasBase2 = CasBase2
    ExCasBase3 = CasBase3
    ExCasBase4 = CasBase4
    ExCasBase5 = CasBase5
'les CasBase1,CasBase2,CasBase3,CasBase4,CasBase5 sont de la meme structure : String
'ils ont la même longueur et se présentent comme ceci : "R/CB/M/M:4,0:0,20"
'avec des lettres qui peuvent changer, et  des chiffres qui peuvent changer
'possibilité de "*" à la place des lettres par la sub Traitement_B5A
End With
Traitement_B5A
End Sub
Sub Traitement_B5A()
For TraitementA = 0 To 7
 CasBase1 = ExCasBase1
    Select Case TraitementA
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            rang = 6
            NouvChaine = "*"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
                CasBase1 = Left(CasBase1, rang - 1) & NouvChaine & Right(CasBase1, Len(CasBase1) - rang - (Len(NouvChaine) - 1))
            Traitement_B5B
        Case 0
            Traitement_B5B
    End Select
Next TraitementA
End Sub
Sub Traitement_B5B()
For TraitementB = 0 To 7
CasBase2 = ExCasBase2
    Select Case TraitementB
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            rang = 6
            NouvChaine = "*"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
                CasBase2 = Left(CasBase2, rang - 1) & NouvChaine & Right(CasBase2, Len(CasBase2) - rang - (Len(NouvChaine) - 1))
            Traitement_B5C
        Case 0
            Traitement_B5C
    End Select
Next TraitementB
End Sub

Sub Traitement_B5C()
For TraitementC = 0 To 7
CasBase3 = ExCasBase3
    Select Case TraitementC
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            rang = 6
            NouvChaine = "*"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
                CasBase3 = Left(CasBase3, rang - 1) & NouvChaine & Right(CasBase3, Len(CasBase3) - rang - (Len(NouvChaine) - 1))
            Traitement_B5D
        Case 0
            Traitement_B5D
    End Select
Next TraitementC
End Sub

Sub Traitement_B5D()
For TraitementD = 0 To 7
CasBase4 = ExCasBase4
    Select Case TraitementD
        Case 1 'cas 100
            rang = 1
            NouvChaine = "*"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
        Case 2 ' cas 010
            rang = 3
            NouvChaine = "**"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
        Case 3 'cas 001
            rang = 6
            NouvChaine = "*"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
        Case 4 ' cas 110
            rang = 1
            NouvChaine = "*/**"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
        Case 5 'cas 011
            rang = 3
            NouvChaine = "**/*"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
         Case 6 'cas 101
            rang = 1
            NouvChaine = "*"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            rang = 6
            NouvChaine = "*"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
       Case 7 'cas 000
            rang = 1
            NouvChaine = "*/**/*/*"
                CasBase4 = Left(CasBase4, rang - 1) & NouvChaine & Right(CasBase4, Len(CasBase4) - rang - (Len(NouvChaine) - 1))
            Traitement_B5E
        Case 0
            Traitement_B5E
    End Select
Next TraitementD
End Sub

Sub Traitement_B5E()
On Error GoTo Erreur12
For TraitementE = 0 To 7
CasBase5 = ExCasBase5

    Select Case TraitementE
        Case 1
            rang = 1
            NouvChaine = "*"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
        Case 2
            rang = 3
            NouvChaine = "**"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
        Case 3
            rang = 6
            NouvChaine = "*"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
        Case 4
            rang = 1
            NouvChaine = "*/**"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
        Case 5
            rang = 3
            NouvChaine = "**/*"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
         Case 6
            rang = 1
            NouvChaine = "*"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
            rang = 6
            NouvChaine = "*"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
       Case 7
            rang = 1
            NouvChaine = "*/**/*/*"
                CasBase5 = Left(CasBase5, rang - 1) & NouvChaine & Right(CasBase5, Len(CasBase5) - rang - (Len(NouvChaine) - 1))
        Case Else
    End Select
    
    'voila on a les portions LaCol__APx que l'"on recolle pour faire LaCol__AP Qui sera affichée (LaCol__AP a auparavent été Redim dans cette Sub qui est la derniere du Traitement des bouts
    
    RienCas = RienCas + 1
    LesCasPourDateFutur(RienCas) = CasBase1 + "-" + CasBase2 + "-" + CasBase3 + "-" + CasBase4 + "-" + CasBase5
    'ICI est la construction des LesCasPourDateFutur(RienCas)
    MaxRienCas = RienCas
Next TraitementE

Exit Sub
Erreur12:
RienL = RienL
Stop: Resume
End Sub

Sub Rechercher()
DernierJour
QuelleDate
If LigneDateFutur = 0 Then
    MsgBox "Pas Une Date Significative"
    Exit Sub
End If
RienLResult = 8
ListeDesCasParPage
 'là on a le tableau de chaines LesCasPourDateFutur(RienCas) avec RienCas de 1 à MaxRienCas
Cinq_B5_LireVirtuel
End Sub
0
Réponse 8 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
12 févr. 2015 à 00:07
ici la Sub de départ est :
Sub Rechercher
dans le programme d'écriture précédent la Sub de départ est :
Sub Cinq_B5

bien que ce soit un peu long comme script, je te l'ai mis pour que tu puisses avoir le maximum d'éléments.
merci encore de tes conseils
amicalement
Claude
0
Réponse 9 / 13
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
12 févr. 2015 à 07:05
Houlà ! Tout cela me donne le vertige (trop d'enchevêtrements, etc ... qui rendent l'analyse extrêmement pénible à faire) et tend à me convaincre que tu prends des détours inutiles.
Selon toute apparence :

- tes fichiers textes sont dressés à partir de données de feuilles de Excel, puis utilisés pour dresser deux tableaux dynamiques, à comparer ensuite !

- pourquoi passer par des fichiers textes ?
--- VBA/Excel permet de dresser un tableau dynamique directement.

- Pourquoi même passer par des tableaux dynamiques et ne pas travailler directement sur les plages ?
-- ce qui te permettrait de profiter très utilement de ce que t'offre VBA/Excel : Find, CountIf, ....

________________________________________

Tu as dans ton code beaucoup de maladresses et lourdeurs, à corriger. Je ne veux pas en faire un inventaire exhaustif (trop long), mais t'en montrer quelques aspects seulement :
1) 
Str(Day(Date)) + "-" + Str(Month(Date)) + "-" + Str(Year(Date)) + "-" + Str(Hour(Time)) + "H -" + Str(Minute(Time)) + "Mn"

n'est finalement rien d'autre que : 
Format(Now, "dd-mm-yyyy-hh\H-mm\M\n")

2) il y a abus de "cache-misères" "On Error Resume Next" !
Pour ton info :
----- le fichier c:\toto\titi.txt n'existe pas si Dir("c:\toto\titi.txt") = ""
---- il n'est même pas utile de tuer un fichier lorsqu'ouvert en écriture. Il est écrasé automatiquement, sauf si en mode Append (et là, par définition, on le tue pas non plus !)

J'arrête là cet "inventaire", car serait trop long...

____________________________________________________

Je te conseille donc vivement de repartir à zéro sur ce projet.
Mais si tu tiens vraiment (j'insiste sur cet adverbe) à continuer sur la voie que tu t'es tracée (deux tableaux dynamiques à comparer) , la double boucle sera inévitable, sauf à passer par encore un autre tremplin (collection ou dictionnaire)

Sans collection ou dictionnaire, on ne pourrait qu'alléger ces boucles en triant au préalable les deux tableaux dynamiques ! Ah ? Oui, mais ces tris eux-mêmes alourdiraient la durée !


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
0
Réponse 10 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
12 févr. 2015 à 10:01
Bonjour et ... MERCI!

- tes fichiers textes sont dressés à partir de données de feuilles de Excel, puis utilisés pour dresser deux tableaux dynamiques, à comparer ensuite !

- pourquoi passer par des fichiers textes ?
--- VBA/Excel permet de dresser un tableau dynamique directement.

Réponse :
je désire garder les éléments du tableau pour les réutiliser à nouveau sans avoir à les recalculer à chaque fois (long), et donc je les garde sous forme de fichier.
d'autant plus que ce programme va être exécuter quelques centaines de fois avec des données différentes (de même structure)
d'où l'idée d'un programme d'écriture séparé d'un programme de lecture les rendant complètement indépendants.

- Pourquoi même passer par des tableaux dynamiques et ne pas travailler directement sur les plages ?
Réponse : car j'ai bien plus que 1 000 000 de lignes (maximum d'une feuille excel) et je ne sais comment gérer ce problème. car en effet si tout tenait sur une feuille, ce serai plus simple. cette limite n'existe pas dans les fichiers et les tableaux.... as tu une idée?

Tu as dans ton code beaucoup de maladresses et lourdeurs, à corriger.
Réponse :
Bonne idée :)
eh oui.... je vais m'y remettre.
cependant avant de tout "nettoyer" pour avoir un code propre, je voudrais avoir une solution pour mes boucles... afin d'éviter de faire encore des lourdeurs.

2) il y a abus de "cache-misères" "On Error Resume Next" !
Réponse :
cela c'est peut être le plus facile à corriger :)
merci pour : Dir("c:\toto\titi.txt") = "" et Format(Now, "dd-mm-yyyy-hh\H-mm\M\n")

sauf à passer par encore un autre tremplin (collection ou dictionnaire)
Réponse :
je n'ai jamais encore utilisé les collection ou les dictionnaires ... connais tu où je pourrais avoir une aide pour commencer à les utiliser?(car l'aide excel n'est pas très claire) cela me permettrai de progresser.

enfin j'insiste pour te remercier vivement de ton aide et de ton temps précieux que tu me consacre.
Claude
0
Réponse 11 / 13
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
12 févr. 2015 à 11:11
Tu as ici l'essentiel de ce qu'il faut savoir en ce qui concerne les dictionnaires :
http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm
Les collections fonctionnent sur un principe presque identique. Tu trouveras là une discussion qui devrait t'intéresser :
http://stackoverflow.com/questions/40651/check-if-a-record-exists-in-a-vb6-collection
Si tu as tant de lignes (plus de 1 000 000), il est peut-être "téméraire" d'utiliser Excel comme base de données. Une vraie base de données serait plus adaptée.
0
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
12 févr. 2015 à 12:08
Une vraie base de données serait plus adaptée... peux tu m'en conseiller une?
je ne suis qu'amateur en informatique (comme tu as pu le constater avec mon code)

Je viens de regarder
http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm
IMPRESSIONNANT la rapidité de tri :)))
et il est super clair!
Merci Beaucoup
je refais mon code au propre....
ceci GRACE à toi :))
1000 merci ... (plus de 1 000 000 LOL)
Claude
0
Réponse 12 / 13
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
12 févr. 2015 à 12:56
N'importe laquelle ferait l'affaire, compte tenu de la relative simplicité de ce que tu cherches à faire avec les données.
0
Réponse 13 / 13
ClaudeDordogne Messages postés 47 Date d'inscription mardi 13 janvier 2015 Statut Membre Dernière intervention 7 mars 2015
12 févr. 2015 à 13:08
peux tu me donner le nom d'une base de données simple?

Voilà, Grace à Toi, j'ai enfin toutes les réponses à mes soucis
je vais donc :
reprendre mon code
utiliser les dictionnaires
afin que cela soit propre, rapide et clair
ensuite je verrai pour une base de donnée.
je tiens particulièrement à te remercier pour ton aide si précieuse, claire, sympa et efficace.
c'est avec un grand plaisir que je te dis : MERCI
et je marque comme "résolu" :))
0

Discussions similaires

boucle for avec un pas de 2
ludomontbaze -
Renfield -

3 réponses
Sortir proprement d'une boucle
superjabar -
buno -

6 réponses
sortir d'une boucle for each
devil_recycler -
devil_recycler -

3 réponses
foreach en SQL ?
bootchoz -
bootchoz -

5 réponses
boucle de calcul ( for (i=1;i<7;i++) )
attarte -
attarte -

2 réponses
Rejoignez-nous