Sujet Précédent Sujet Suivant

Variable tableau dans un autre tableau

Thomas1806 Messages postés 4 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 20 juillet 2009 - 20 juil. 2009 à 09:17
Thomas1806 Messages postés 4 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 20 juillet 2009 - 20 juil. 2009 à 13:50
Bonjour à tous quelqu'un aurait une solution pour copier ma variable TabNomRep () dans une autre variable tableau a dimension variable Tab1 () 
Option Explicit
Public nb As Integer

Sub Appel()
    Dim chemin As String
    nb = 0
    chemin = "C:\APT\PROGRAM\LIGNES\UNITS"
    Lister chemin
End Sub
Public Function Lister(chemin As String)
'déclaration de variables
    Dim fs As Variant
    Dim Rep As Variant
    Dim NewRep As String
    Dim Nomfich As String
    Dim Temp As String
    Dim Ligne As Integer
    Dim Z As Integer
    Dim nbFichierSFC As Integer
    Dim Colonne As Integer
    Dim w As Integer
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.sfc")
    
    Do While Nomfich <> ""
        nb = nb + 1
        Cells(nb, 10) = chemin & "" & Nomfich 'liste dans la feuille de calculs active
        Nomfich = Dir()
    Loop

    For Each Rep In fs.GetFolder(chemin).SubFolders
        NewRep = Lister(Rep.Path)
    Next Rep
    

    'initialisation des variables
    Z = 0
    w = 1
    Ligne = 1
    Colonne = 1
    Temp = Dir("C:\APT\PROGRAM\LIGNES\UNITS\*.", vbDirectory)

    'Boucle de récupération des noms de dossiers
    Do
        If Temp = "" Then
            Exit Do
        ElseIf Temp "." Or Temp ".." Then
            'Ne rien afficher
        Else
            ReDim Preserve TabNomRep(0 To Z)
            Cells(Ligne, Colonne) = Temp
            Ligne = Ligne + 1
            TabNomRep(Z) = Temp
            Z = Z + 1
        End If
        Temp = Dir
    Loop


'-------------------------------------------------------------
'réorganisation excel

Dim DernièreLigneFichiers, NomFichier As Variant
Dim DernièreLigneUnits As Variant
Dim ligneUnits As Integer
Dim ligneFichier As Integer
Dim PosSlash As Integer
Dim PointeurColFichiers As Integer
Dim nbSlash As Integer
Dim nbLigneUnit As Integer
Dim nbLigneUnitTab As Integer
Dim redimTab As Integer

DernièreLigneFichiers = 1
Dim MyXlRange As Excel.Range

Set MyXlRange = ActiveSheet.Range("A:A")
    DernièreLigneUnits = MyXlRange.End(xlDown).Row
Set MyXlRange = ActiveSheet.Range("j:j")
    DernièreLigneFichiers = MyXlRange.End(xlDown).Row

    nbFichierSFC = 1
    redimTab = 1
    
    nbLigneUnit = 0
    nbLigneUnitTab = 0

    Do
            For ligneFichier = 1 To DernièreLigneFichiers
                PosSlash = 0
                
                'Récupération position du slash
                For nbSlash = 1 To 6
                    PosSlash = InStr(PosSlash + 1, Range("J" & CStr(ligneFichier)), "")
                Next nbSlash
                                
                                
                'Récupération du nom de fichier
                NomFichier = Left(Range("J" & CStr(ligneFichier)), PosSlash)
                
               
                'Vérification: si le nom du répertoire est dans le chemin
                If InStr(1, NomFichier, TabNomRep(nbLigneUnitTab)) <> 0 Then
                    ReDim Preserve Tab1((DernièreLigneUnits - 1), 1 To redimTab)
                    Tab1(nbLigneUnit, nbFichierSFC) = Range("J" & CStr(ligneFichier))
                    nbFichierSFC = nbFichierSFC + 1
                    If nbFichierSFC > redimTab Then
                        redimTab = redimTab + 1
                    End If
                Else
                'On change d'index
                    nbFichierSFC = 1
                    nbLigneUnit = nbLigneUnit + 1
                    nbLigneUnitTab = nbLigneUnitTab + 1
                End If
            Next ligneFichier
            
    Loop While (nbLigneUnitTab > (DernièreLigneUnits - 1))
            



End Function




Merci

2 réponses

Réponse 1 / 2
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
20 juil. 2009 à 10:38
Salut
Je n'ai pas eu le courage de regarder tes lignes.

Pour transférer le contenu d'un tableau entier : 
    Dim monTableau(1 To 3) As String
    Dim NewTableau() As String
    Dim r As Long
    
    monTableau(1) = "Codes-Sources"
    monTableau(2) = "est"
    monTableau(3) = "Formidable"
    
    NewTableau = monTableau
    
    For r = 1 To 3
        Debug.Print " "; NewTableau(r);
    Next r


Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0
Réponse 2 / 2
Thomas1806 Messages postés 4 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 20 juillet 2009
20 juil. 2009 à 13:50
Ok ok merci je vais modifier cela :)
0

Discussions similaires

afficher un tableau en php
Larose_1921 -
s -

1 réponse
tableau de nombre décimal vers tableau de nomber binaire
mkhadi -
mkhadi -

2 réponses
Turbo C++
cs_jrod -
cmarsc -

1 réponse
Etablir toutes les combinaisons possibles du Lotto
KBNchapal -
Mikaels35 -

6 réponses
TURBO C++ et blocks que choisir
norman bates -
Vale Erian -

1 réponse
Rejoignez-nous