extraire des données

[peygase]

bonjour
Jais crée 12 dossier (leur nom son les mois de l'année)
dans chaque dossier le nombre de classeur et équivalant au jour travaillé exemple (nom des classeur)------( 0101) -----(0201)-----(0301)…exemple pour le moi de janvier). Comment récupéré les donné dans un classeur récap
Les ligne de donné son (de c22 a n22 ainsi que o21).
La mise en forme des classeurs et identique je voudrai réunir les classeurs de chaque jour pour avoir un recap du moi et ce pour chaque moi.

voila un debut

Sub LitDatas()
Dim Fich$, Arr, L As Integer, C As Integer, N2 As String
Dim X As Integer, Y As Integer
Dim Chemin As String

'chemin des classeurs à adapter
Chemin = c:\Users\peygase\Desktop\JANVIER '

With ThisWorkbook.Sheets('Recap')
For C = 1 To 31
If C < 10 Then
N2 = 'récapitulaif journalier' & C
ElseIf C < 100 Then
N2 = 'Xl0' & C
Else: N2 = 'Xl' & C
End If
Fich$ = Chemin & N2
If .Range('A1') = '' Then
L = 0
Else: L = .Range('A65536').End(xlUp).Row
End If
'récup des données à partir de l'adresse d'une plage de cellules
' si noms de champ changer false en true
GetExternalData Fich, récapitulatifjournalier ', c22:l22, False, Arr
'récup des données à partir du nom d'une plage de cellules ()
' GetExternalData Fich, '', 'plagenommée', False, Arr
' .Range('A1', .Cells(UBound(Arr, 1), UBound(Arr, 2))).Offset(L, 0).Value = Arr
For X = 1 To UBound(Arr, 1) 'lignes
For Y = 1 To UBound(Arr, 2) 'colonnes
If Arr(X, Y) <> '' Then .Cells(X, Y).Offset(L, 0).Value = Arr(X, Y)
Next Y
Next X
Fich = ''
Next C
End With


End Sub
les numero de fichier du 1 janvier donc 0101 au 31 decembre 3112
le classeur nommé 0101 ligne de transphere (c22 a n22) sur recap ligne c1 a n1
le classeur nommé 0201 ligne de transphere (c22 a n22) sur recap ligne c2 a n2
je suis nul en vba si quelqun peu maidé
merci @+

 

[soenda]

Re : extraire des données

Bonjour le fil, Peygase

Deux, trois petites choses, avant d'alller plus loin:

1) Fait un effort sur la lisibilité (ne serais-ce que pour ton confort).
Aère ton code et regarde la partie déclaration comme dans l'exemple qui suit.

2) Le signe ' sert pour les commentaires. Un commentaire n'est pas du code. Dans l'exemple comme dans l'éditeur de VBA, les commentaires sont colorés en vert
- Le signe " sert à délimiter une chaine de caractère. Si tu utilises ' à la place de " dans une ligne de code, le compilateur te signalera l'erreur en colorant toute la ligne en rouge.
Dans l'exemple qui suit, les corrections que j'ai effectué, sont signalées en rouge, pour que tu les vois.

3) Enfin je me suis arrêté dans la correction, au premier commentaire, que je n'ai pas compris...

Sub LitDatas()
[SIZE=3][COLOR=#00b050][SIZE=3][COLOR=#00b050]' Pour la lisibilité, une ligne par type de variable[/COLOR][/SIZE]
[/COLOR][/SIZE][SIZE=3]Dim Fich$, Chemin$, N2 as String [/SIZE][SIZE=3][COLOR=#00b050][SIZE=3][COLOR=#00b050]' Déclaration des String[/COLOR][/SIZE]
[/COLOR][/SIZE][SIZE=3]Dim X%, Y%, L%, C As Integer     [/SIZE][SIZE=3][COLOR=#00b050][SIZE=3][COLOR=#00b050]' Déclaration des Integer[/COLOR][/SIZE]
[/COLOR][/SIZE][SIZE=3]Dim Arr as Variant               [/SIZE][SIZE=3][COLOR=#00b050][SIZE=3][COLOR=#00b050]' Déclaration du Variant[/COLOR][/SIZE][/COLOR][/SIZE]
 
[SIZE=3][COLOR=#00b050][SIZE=3][COLOR=#00b050]' Chemin des classeurs à adapter [/COLOR][/SIZE]
[/COLOR][/SIZE][SIZE=3]Chemin =[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000] "[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]c:\Users\peygase\Desktop\JANVIER[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE]
[SIZE=3]With ThisWorkbook.Sheets([/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]Recap[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]) [/SIZE]
[SIZE=3]For C = 1 To 31 [/SIZE]
[SIZE=3]If C < 10 Then [/SIZE]
[SIZE=3]   N2 = [/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]récapitulaif journalier[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3] & C [/SIZE]
[SIZE=3]ElseIf C < 100 Then [/SIZE]
[SIZE=3]   N2 = [/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]Xl0[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3] & C [/SIZE]
[SIZE=3]Else[/SIZE]
[SIZE=3]   N2 = [/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]Xl[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3] & C [/SIZE]
[SIZE=3]End If[/SIZE]
 
[SIZE=3]Fich$ = Chemin & N2 [/SIZE]
[SIZE=3]If .Range([/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]A1[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]) = [/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]""[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3] Then [/SIZE]
[SIZE=3]   L = 0 [/SIZE]
[SIZE=3]Else[/SIZE]
[SIZE=3]   L = .Range([/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]A65536[/SIZE][SIZE=3][COLOR=#ff0000][SIZE=3][COLOR=#ff0000]"[/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3]).End(xlUp).Row [/SIZE]
[SIZE=3]End If[/SIZE]
 
[SIZE=3][COLOR=#00b050][SIZE=3][COLOR=#00b050]' Récup des données à partir de l'adresse d'une plage de cellules [/COLOR][/SIZE]
[SIZE=3][COLOR=#00b050]' si noms de champ changer false en true [/COLOR][/SIZE][/COLOR][/SIZE][SIZE=3][COLOR=#d19049][SIZE=3][COLOR=#d19049]( <== ici j'ai pas compris)[/COLOR][/SIZE]
[/COLOR][/SIZE][SIZE=3]...[/SIZE]

A plus

 

[peygase]

Re : extraire des données

Tout d'abor merci d'avoir consacré du temps a mon problème quand je dit que je suis nul en vba le mots et faible bref on ma envoyé un code et je ne comprend pas tous !! faut 'il renoncé a comprendre
voila le code ou les codes
'---------------------------------------------------------------------------------------
' Module : modRecap
' Description : Groupement des informations recueillies sur une
' même ligne de plusieurs fichiers d'un même dossier racine.
'---------------------------------------------------------------------------------------
' référence à Microsoft Scripting Runtime
' référence à Microsoft ActiveX Data Object X.X Library
'---------------------------------------------------------------------------------------
Option Explicit
Option Base 1
Const Racine As String = "F:\CAMIONNAGE\CHARGEMENT\"
Dim monTab As Variant
Dim i As Long
Dim DerLi As Long
Dim maLigne As Long
Sub Lancement()
'---------------------------------------------------------------------------------------
' Procédure : Lancement
' Description : Macro de départ, lance les macros suivantes :
' ListerFichiersDansDossier
' RechercheLigne --> autant de fois que de fichiers listés.
' CopieADO --> autant de fois que de fichiers listés.
'---------------------------------------------------------------------------------------
'
Application.ScreenUpdating = False
monTab = Array()
DerLi = Columns("B").Find("*", , , , , xlPrevious).Row

ListerFichiersDansDossier Racine, True
For i = 1 To UBound(monTab)
RechercheLigne monTab(i)
CopieADO monTab(i)
Next i
Application.ScreenUpdating = True
MsgBox "Opération terminée."
End Sub
Sub CopieADO(fichier)
'---------------------------------------------------------------------------------------
' Procédure : CopieADO
' Description : Copier dans le classeur fermé listé précédemment
' les cellules C22:N22 de l'onglet
' "récapitulatif journalier" et coller les valeurs
' sur la ligne trouvé précédemment
'---------------------------------------------------------------------------------------
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim strSql As String
Dim Plage As String
Dim Feuille As String
Plage = "C22:N22"
Feuille = "récapitulatif journalier"
strSql = "SELECT * FROM [" & Feuille & "$" & Plage & "]"

Set Cn = New ADODB.Connection

Cn.Open Quel_Provider(fichier, "no")
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
Set Rst = New ADODB.Recordset

Rst.Open strSql, Cn, adOpenKeyset, adLockOptimistic

Set Rst = Cn.Execute(strSql)

Range("C" & maLigne).CopyFromRecordset Rst

Rst.Close: Cn.Close
Set Rst = Nothing: Set Cd = Nothing: Set Cn = Nothing

End Sub
Sub RechercheLigne(fichier)
'---------------------------------------------------------------------------------------
' Procédure : RechercheLigne
' Description : Rechercher la date dans le nom du fichier.
' recherche de la ligne correspondant à cette date,
' afin de coller les valeurs copiées sur cette ligne.
'---------------------------------------------------------------------------------------
'Je te conseille d'ajouter un dossier dans ton arborescence
'"F:\CAMIONNAGE\CHARGEMENT\" & 2009,
'pour éviter les conflits l'année prochaine.
'Tu trouveras pour cela une macro pour la création
'des dossiers en bas de ce module
'ex: "F:\CAMIONNAGE\CHARGEMENT\2009\02-FÉVRIER\0402.xls"
Dim StrInv As String
Dim AD As Long
Dim Annee As Integer
Dim maDate As Date
StrInv = StrReverse(fichier)
AD = InStr(1, StrInv, Application.PathSeparator)
Annee = InStr(1, fichier, 20)
Annee = Mid(fichier, Annee, 4)
maDate = CDate(StrReverse(Mid(StrInv, AD - 2, 2)) & "/" & _
StrReverse(Mid(StrInv, AD - 4, 2)) & "/" & _
Annee)
maLigne = Application.Match(CLng(maDate), Range("B3:B" & DerLi).Value2, 0) + 2
End Sub
Sub ListerFichiersDansDossier(CheminSource As String, _
InclureSousDossiers As Boolean)
'---------------------------------------------------------------------------------------
' Procédure : ListerFichiersDansDossier
' Description : Lister tous les fichier du répertoire source.
' Mettre leur chemin dans un tableau.
'---------------------------------------------------------------------------------------
'
'd'après une macro d' Ole P Erlandsen
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder
Dim SousDossier As Scripting.Folder
Dim fichier As Scripting.File

Set FSO = New Scripting.FileSystemObject
Set DossierSource = FSO.GetFolder(CheminSource)

For Each fichier In DossierSource.Files
' remplissage du tableau
ReDim Preserve monTab(UBound(monTab) + 1)
monTab(UBound(monTab)) = fichier.Path
Next fichier

If InclureSousDossiers Then
For Each SousDossier In DossierSource.SubFolders
ListerFichiersDansDossier SousDossier.Path, True
Next SousDossier
End If

Set fichier = Nothing
Set DossierSource = Nothing
Set FSO = Nothing
End Sub
Function Quel_Provider(fichier, EnTete)
'---------------------------------------------------------------------------------------
' Fonction : Quel_Provider

' Description : Ajuster le "Provider" en fonction de la version d'Excel utilisé
'---------------------------------------------------------------------------------------
'
Dim Provid As String
Dim ExtProp As String

If Val(Application.Version) < 12 Then
'avant Excel 2007
Provid = "Microsoft.Jet.OLEDB.4.0"
ExtProp = "Excel 8.0"
Else
'excel 2007
Provid = "Microsoft.ACE.OLEDB.12.0"
ExtProp = "Excel 12.0"
End If

Quel_Provider = "Provider=" & Provid & _
";Data Source=" & fichier & _
";Extended Properties=""" & ExtProp & _
";HDR=" & Application.Proper(EnTete) & ";"""
End Function
Sub CreationDossier()
'---------------------------------------------------------------------------------------
' Procédure : CreationDossier
' Description : Créer l'arborescence pour un an
'---------------------------------------------------------------------------------------
'
On Error Resume Next
MkDir "F:\CAMIONNAGE"
MkDir "F:\CAMIONNAGE\CHARGEMENT"
MkDir "F:\CAMIONNAGE\CHARGEMENT\" & Year(Date)
For i = 1 To 12
MkDir "F:\CAMIONNAGE\CHARGEMENT\" & Year(Date) & "\" & _
Format(i, "00") & "-" & UCase(MonthName(i))
Next
On Error GoTo 0
End Sub

jai incérè le code dans un bouton ca donne rien jai crée un fichier 2009 inversé les dates
ex: 7 janvier (0701)===>0107
et je comprent pas ou et le problem
merci quand meme je continue a tésté