Discussion :

[trickshot]

Bonjour je souhaite récupérer les mêmes données dans plusieurs fichiers.
Le fichier source est comme ceci :
J'ai réussi à insérer les differentes données dans un fichier récapitulatif :


Sauf pour la colonne K,OC load, qui correspond a la valeur maxi de chargement en Newton soit la colonne B du fichiers sources.
Je ne comprend pas pourquoi ma valeur obtenue est fausse, j'ai utilisé fonction Application.WorksheetFunction.Max
La macro pour trouver le maximum marche tout seule, mais des que j'essaye de l’intégrer a ma macro qui ouvre la feuille et récupère les données la valeur donnée n'est pas bonne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set Cellules = Range("B23:B26")
Set Cellules = ActiveSheet.Range("B23:B26")
Range("D20").Value = Application.WorksheetFunction.Max(Cellules)

Je dois bien effectuer ce calcul entre le moment où j'ouvre mon fichier source et où je copie les données?
Ci vous pouvez m'éclairer.

De plus j'ai besoin d'aide pour calculer également une pente dans chaque fichier source puis l'inserer dans mon fichier récapitulatif, entre 20 et 50N avec le déplacement correspondant, seulement entre les différents fichiers ce n'est pas forcement les même cases. Il faudrait trouver auparavant les cases où la valeur est entre 20 et 50. Tester case après case, si la valeur de la cellule est >20 on commence la sélection (avec sa coordonnée de déplacement correspondante) et lorsque la valeur de la cellule est >50 on met fin a la selection. Mais en pratique je ne sais pas comment m'y prendre.

Je suis débutant en macro excel, j'ai quelques connaissances en langage VB.
Merci d'avance.
Ci joint le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
'------------------------------------------------------------------------------
' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' GCXL
'-------------------------------------------------------------------------------
Sub Creer_Recapitulatif()
Dim wbRecap As Workbook 'fichier recap
Dim wsRecap As Worksheet 'feuille où on écrit les données
Dim wbSource As Workbook 'fichier à ouvrir
Dim wsSource As Worksheet 'feuille où on cherche les données
Dim DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim i As Integer, k As Integer
Dim rgRecap As Range 'plage où on copie les données
Dim Cellules As Range

Set wbRecap = ThisWorkbook 'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets(1) 'on écrit dans la feuille 1 du fichier récapitulatif

' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers

' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next

Application.ScreenUpdating = False

' --- Boucle à travers les fichiers
For k = 1 To UBound(vFichiers)
Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~
' C'est ici qu'on écrit les instructions
Set wbSource = Workbooks.Open(vFichiers(k)) 'on ouvre le fichier
Set Cellules = Range("B23:B26")
Set Cellules = ActiveSheet.Range("B23:B26")
Range("D20").Value = Application.WorksheetFunction.Max(Cellules)
Set wsSource = wbSource.Sheets(1) 'On copie les données de la feuille 1
DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 1 'ligne pour écrire le log des fichiers compilés

' - On copie les données vers le fichier Recapitulatif; à adapter
Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
rgRecap = wbSource.Name

With wsSource
rgRecap.Offset(0, 1) = .Range("B13")
rgRecap.Offset(0, 2) = .Range("B15")
rgRecap.Offset(0, 3) = .Range("B14")
rgRecap.Offset(0, 4) = .Range("B20")
rgRecap.Offset(0, 5) = .Range("B22")
rgRecap.Offset(0, 7) = .Range("B17")
rgRecap.Offset(0, 8) = .Range("B23")
rgRecap.Offset(0, 10) = .Range("D20")

End With

wbSource.Close 'fermer fichier
Set wbSource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~
Next k

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean

sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function

J'ai joint 6 fichiers sources comme exemple et mon fichier récapitulatif pour aider a la compréhension du problème.

[had4789]

Bonjour,

Pour ton premier problème vérifie les cases que tu sélectionnes.

Tu peux aussi adapter ce code qui copie la valeur de la celulle A1 dans al celulle A1 de la feuille 2 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Range("A1").Copy Destination:=Sheets("Feuil2").Range("A1")

Pour ton second problème tu as la solution.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 IF Cell.Value >20 And Cell.Value<50 Then
'Ce que tu veux faire

[trickshot]

Merci had pour ta réponse rapide!

En effet je n'avais pas sélectionné les bonnes cases, j'ai passé la matinée dessus je devais pu avoir les yeux en face des trous

Pour mon 2eme problème je pensais à qq chose comme ça:

Je test les valeurs de la colonne B, a partir de B23. Donc faire deux boucles d'itérations, du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
For Each Cell In Ws.Range("B23:B300")
      If Cell.Value > 20 Then Je selectionne cette cellule et celle de gauche ...
                                       For each Cell 
                                                If Cell.Value >50 Then je desélectionne Exit For
                                       Next Cell
Next Cell

La fonction pour faire une pente c'est bien : Application.WorksheetFunction.Slope(Arg1,Arg2) ?
J'ai du mal a savoir comment l'intégrer dans mon test logique

[had4789]

Je pense que tu n'as toujours pas les yeux en face des trous

Dans ton code tu écris > 20 je sélection et > 50 je désélectionne. Si ta cellule vaut 5 ou 75 ton code va être perdu.

Slope permet effectivement de faire une régression linéaire.

On va essayer d'être clair. Tu veux calculer (en D2 si j'ai bien suivie) la valeur de la pente, sachant que la valeur du déplacement est dans la colonne C?

[trickshot]

Oui tu as raison <50 je voulais dire, la journée fut rude ^^

En résumé j'ai plusieurs fichiers avec chacun des valeurs différentes mais toujours structuré de la même manière :


Dans ce cas précis la pente à calculer sera : =PENTE(B41:B69;A41:A69), avec B la colonne de l'effort et A la colonne de déplacement.
Sauf que les cellules avec lesquels je calcul la pente (ici B41:B69;A41:A69) ne sont pas forcement les même entre les différents fichiers, cela peut être entre B15:B55 et A15:A55 par exemple.
En effet je veux calculer la pente seulement entre 20 et 50 Newton (valeur de la colonne B), l'afficher dans n'importe quel cellule de la colonne D par exemple D19, et ceci pour chaque fichier afin d'insérer cette valeur ( la rigidité en réalité) dans mon fichier récapitulatif de la même manière que pour le maximum vu précédemment.

J'ai essayé d'être le plus claire possible

[had4789]

Bonjour,

Dis moi simplement siil y a une erreur pour que je corrige:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub g()
 
Application.ScreenUpdating = False
 
 Sheets("Feuil1").Range("A2:B2").Copy Destination:=Sheets("Feuil2").Range("A2:B2")
 'Tu copies tes valeurs dans une autres feuilels car on n'est jamais trop prudent
 'On ne prend pas les titres car on n'es a pas besoin pour le calcul
 
 
Dim i As Integer
Sheets("Feuil2").Select
 
 
 
With ThisWorkbook.Sheets("Feuil2")
'Précisez le nom de votre feuille
            For i = .Range("B" & .Rows.count).End(xlUp).Row To 1 Step -1
'je travaille sur la colonne B
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("B" & i).Value < 20 Then
                                   .Rows(i).delete
 
                                   ElseIf .Range("B" & i).Value > 50 Then
                                   .Rows(i).delete
 
                        End If
            Next i
End With
 
Set Range("D20").Value = Application.WorksheetFunction.Slope("A:A", "B:B")
 
 
End Sub

[trickshot]

Finalement j'ai fait comme ceci, il me semble plus simple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim j As Integer
Dim debut, fin As Integer
For j = 26 To Sheets(1).Range("A65536").End(xlUp).Row
    If debut = 0 Then
        If Range("B" & j).Value > 20 Then debut = j
    Else
        If Range("B" & j).Value > 50 Then
        fin = j - 1
        Exit For
    End If
    End If
Next j
 
Range("D19").FormulaLocal = "=pente(B" & debut & ":B" & fin & ";A" & debut & ":A" & fin & ")"

C'est a peu près la même chose que le tien, cependant j'ai des difficultés sur cette ligne de ton code:
For i = .Range("B" & .Rows.count).End(xlUp).Row To 1 Step -1
Je n'ai pas compris ton explication sur Rows.count, et pourquoi un pas de -1?
Et .Rows(i).delete va supprimer les lignes non comprises entre 20 et 50 c'est ça?

[had4789]

Un pas de -1 car on fait la procédure de bas en haut (Xlup)

.Rows(i).delete va supprimer cette ligne en effet si tu lui indiques bien dans ton code car pour une raison qui m'échappe tu continue à te tromper dans les <>