Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2280 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Retournement disposition cellules

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Retournement disposition cellules

n°1368153
elkhy
Posté le 16-05-2006 à 19:19:18  profilanswer
 

Bonjour à tous,  
 
J'ai un dossier qui contient plusieurs fichiers Excel.  
Je lis chacun de ces fichiers de ce dossier afin de pouvoir  
récupérer les données d'un onglet spécifique.  
 
Voici mon code
 
Option Explicit
Option Base 1
 
Sub importCellules_ClasseursFermes()
'
'Necessite d'activer la reference Microsoft ActiveX Data Object 2.x Library
'
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCmd As ADODB.Command
Dim Fichier As String, Direction As String
Dim Repertoire As String, Feuille As String
Dim X As Integer, NbFichiers As Integer, i As Integer
Dim Tableau() As String
Dim Cellule()
 
'Nom de répertoire à changer: mettre l'emplacement ou se trouve le fichier exemple
Repertoire = "C:\documents and Settings\repFicExemple"
 
'Boucle pour lister tous les classeur du repertoire cible
Direction = Dir(Repertoire & "\*.xls" )
Do While Len(Direction) > 0
    NbFichiers = NbFichiers + 1
    ReDim Preserve Tableau(1 To NbFichiers)
    Tableau(NbFichiers) = Direction
    Direction = Dir()
Loop
 
'adresse des cellules contenant les valeurs à recuperer
 
 Cellule = Array("A15", "D15", "E15", "F15" )
 
'Je n'arrive pas à récupérer plusieurs lignes
 
'tous les classeurs fermés doivent contenir un onglet nommé "Feuil1"
Feuille = "Feuil1$" 'ne pas oublier d'ajouter $ au nom de la feuille
 
If NbFichiers > 0 Then
    For X = 1 To NbFichiers 'boucle sur les classeurs
 
        'pour ne pas prendre en compte le classeur contenant la macro
        If Tableau(X) <> ThisWorkbook.Name Then
 
            Cells(X, 1) = Tableau(X)
 
            Fichier = Repertoire & "\" & Tableau(X)
 
            Set Source = New ADODB.Connection
            Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
            For i = 1 To UBound(Cellule)
 
                Set ADOCmd = New ADODB.Command
                With ADOCmd
                .ActiveConnection = Source
                'les données sont dans la "Feuil1" des classeurs fermés
                .CommandText = _
                "SELECT * FROM `" & Feuille & Cellule(i) & ":" & Cellule(i) & "`"
                End With
 
                Set Rst = New ADODB.Recordset
                Rst.Open ADOCmd, , adOpenKeyset, adLockOptimistic
 
                Set Rst = Source.Execute("`" & Feuille & _
                Cellule(i) & ":" & Cellule(i) & "`" )
 
                Cells(X, i + 1) = Rst.Fields(0).Value
 
                Rst.Close
                Set Rst = Nothing
                Set ADOCmd = Nothing
            Next i
 
            Source.Close
            Set Source = Nothing
 
        End If
    Next X
End If
End Sub

 
 
 
Voici ce qu'il donne actuellement:
 
NomDuFichier1 ValCellA15 ValCellD15 ValCellE15 ValCellF15
NomDuFichier2 ValCellA15 ValCellD15 ValCellE15 ValCellF15
NomDuFichier3 ValCellA15 ValCellD15 ValCellE15 ValCellF15
...etc
 
J'affiche donc le nom de mon fichier suivi des 4 cellules que j'ai spécifié ici dans mon code:
 
Cellule = Array("A15", "D15", "E15", "F15" )
 
En fait je voudrai récupérer plus que ces 4 cellules de mon fichier.
 
Voici comment ces données sont organisées dans mon fichier:
 
A15 D15 E15 F15 H15 J15 K15 L15
A17 D17 E17 F17 H17 J17 K17 L17
A19 D19 E19 F19 H19 J19 K19 L19
 
Voici ma question:
 
En l'état actuel du code comment puis-je faire pour obtenir une organisation des données comme cela:
 
NomDuFichier1 1 A15 D15    
NomDuFichier1 2 A15 E15
NomDuFichier1 3 A15 F15    
NomDuFichier1 1 A17 D17    
NomDuFichier1 2 A17 E17    
NomDuFichier1 3 A17 F17    
NomDuFichier1 1 A19 D19    
NomDuFichier1 2 A19 E19    
NomDuFichier1 3 A19 F19    
NomDuFichier1 1 H15 J15    
NomDuFichier1 2 H15 K15  
NomDuFichier1 3 H15 L15    
NomDuFichier1 1 H17 J17    
NomDuFichier1 2 H17 K17    
NomDuFichier1 3 H17 L17    
NomDuFichier1 1 H19 J19
NomDuFichier1 2 H19 K19
NomDuFichier1 3 H19 L19
...etc pour les autres fichiers
 
 
 
Merci à tous pour votre aide

mood
Publicité
Posté le 16-05-2006 à 19:19:18  profilanswer
 

n°1368263
kiki29
Posté le 16-05-2006 à 21:56:53  profilanswer
 

Voir code posté le 15-05-2006
http://forum.hardware.fr/hardwaref [...] 0232-1.htm
 
sans compter que cette méthode est environ 7/8 fois plus rapide ( 2s pour traiter 200 fichiers ) par rapport à ADO ( 16 s ) et la 1ere méthode que j'avais utilisé ( 4mn)
 
Prends contact http://forum.hardware.fr/hardwarefr/profil-379045.htm
et je te zippe mon fichier pour ta question du 12-05-2006  
ainsi que l'adaptation que j'en ai fait pour ta question du 16-05-2006
( 9.5s pour traiter 200 fichiers )


Message édité par kiki29 le 17-05-2006 à 04:29:37
n°1368606
elkhy
Posté le 17-05-2006 à 11:57:21  profilanswer
 

re,
 
Bien noté, merci pour tout...
 
A+


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Retournement disposition cellules

 

Sujets relatifs
macro excel pour récupérer cellulesN° de ligne de l'intersection de 2 cellules
[VBA-E] afficher des données dans des cellulesComparer des cellules sous Excel
Controler la taille des cellules avec fpdf en phpfiger des cellules
Redimenssionnement cellulescellules calcul erreur ###
[VBA] Excel différencier cellules vide ou contenant 0DvDthèque - Déplacement de cellules [Excel-VBA]
Plus de sujets relatifs à : Retournement disposition cellules


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR