Copie valeur max et min d'une colonne avec condition

Résolu/Fermé
barrym78 Messages postés 7 Date d'inscription vendredi 5 mai 2017 Statut Membre Dernière intervention 16 mai 2017 - 5 mai 2017 à 11:19
barrym78 Messages postés 7 Date d'inscription vendredi 5 mai 2017 Statut Membre Dernière intervention 16 mai 2017 - 9 mai 2017 à 11:14
Bonjour à tous,

Je dispose d'une macro qui me permet de copier des données d'un fichier Excel (A) vers un Fichier Excel (B)

Dans la suite de mon code je voudrais récupérer la valeur maximale puis minimale d'une colonne du ficher (A) dans des cellules du fichier (B).

Pour être plus clair, le tableau du fichier (A) dispose de deux colonnes une colonne "linéaire" et une colonne "Hauteur", mon but c'est de récupérer la hauteur maximal puis minimale mais uniquement SI la quantité de linéaire est renseignée.



Voici ma macro, mon problème se situe dans la partie 'Copie données hauteurs de voile


Sub Copier_GOST()

Dim Fichier As String
Dim nom_onglet_source As String, nom_onglet_dest As String

'Acceleration du traitement des données
Application.ScreenUpdating = False

'Ouverture fenêtre de selection du fichier d'entrée
Fichier = Application.GetOpenFilename

Workbooks.Open Filename:=Fichier

'Suppression du chemin
Fichier = Dir(Fichier)


'Copie des données générales de l'onglet "Fond" vers l'onglet "DS"

nom_onglet_source = "Fond"
nom_onglet_dest = "DS"


'Copie données fondations

With ThisWorkbook.Sheets(nom_onglet_dest)

.Range("Taux_travail_sol").Value = Workbooks(Fichier).Sheets(nom_onglet_source).Cells(665, 13).Value
.Range("Type_fondations").Value = Workbooks(Fichier).Sheets(nom_onglet_source).Cells(665, 11).Value
.Range("Type_plancher_bas").Value = Workbooks(Fichier).Sheets(nom_onglet_source).Cells(665, 10).Value

End With

'Copie des données générales de l'onglet "Infra" vers l'onglet "DS"

nom_onglet_source = "Infra"
nom_onglet_dest = "DS"

'Copie données temps unitaires

With ThisWorkbook.Sheets(nom_onglet_dest)

.Range("TU_coffrage_voile_infra").Value = Workbooks(Fichier).Sheets(nom_onglet_source).Range("TU_cof_voile").Value
.Range("TU_coffrage_doka_infra").Value = Workbooks(Fichier).Sheets(nom_onglet_source).Range("TU_cof_doka").Value

End With

'Copie données hauteurs de voile

With ThisWorkbook.Sheets(nom_onglet_dest)

.Range("Hauteur_voile_min_infra").Value = Workbooks(Fichier).Sheets(nom_onglet_source).
.Range("Hauteur_voile_max_infra").Value = Workbooks(Fichier).Sheets(nom_onglet_source).

End With


'Fermeture du classeur source
Workbooks(Fichier).Close False

'Confirmation de l'exportation
MsgBox "Chargement des données réussi"

End Sub



Pouvez-vous m'aider dans ma démarche?

Merci d'avance
A voir également:

4 réponses

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
5 mai 2017 à 12:05
Bonjour Barrym, bonjour le forum,

Dans le fichier source, quelles sont les colonnes contenant les données ? Tu utilises des plages nommées et, sans le fichier qui va bien, il m'est impossible de savoir...
0
barrym78 Messages postés 7 Date d'inscription vendredi 5 mai 2017 Statut Membre Dernière intervention 16 mai 2017 2
5 mai 2017 à 13:55
Bonjour ThauTheme,

Je t'ai mis ci-joint des illustrations de mon problème.









Nous pouvons supposer qu'aucune des plages de cellule n'est nommée. J'adapterai la solution par la suite :).

Merci pour ta réponse
0
barrym78 Messages postés 7 Date d'inscription vendredi 5 mai 2017 Statut Membre Dernière intervention 16 mai 2017 2
5 mai 2017 à 13:59
Ça donnerait un code de ce type pour commencer :

Sub Copier()

Dim Fichier As String
Dim nom_onglet_source As String, nom_onglet_dest As String

'Acceleration du traitement des données
Application.ScreenUpdating = False

'Ouverture fenêtre de selection du fichier d'entrée
Fichier = Application.GetOpenFilename

Workbooks.Open Filename:=Fichier

'Suppression du chemin
Fichier = Dir(Fichier)



'Copie des données de l'onglet RDC vers l'onglet DS
nom_onglet_source = "RDC"
nom_onglet_dest = "DS"


ThisWorkbook.Sheets(nom_onglet_dest).Cells(4, 3).Value =
ThisWorkbook.Sheets(nom_onglet_dest).Cells(4, 4).Value =

'Copie des données de l'onglet RDC vers l'onglet DS
nom_onglet_source = "R+1"
nom_onglet_dest = "DS"


ThisWorkbook.Sheets(nom_onglet_dest).Cells(5, 3).Value =
ThisWorkbook.Sheets(nom_onglet_dest).Cells(5, 4).Value =

'Copie des données de l'onglet RDC vers l'onglet DS
nom_onglet_source = "R+2"
nom_onglet_dest = "DS"

ThisWorkbook.Sheets(nom_onglet_dest).Cells(6, 3).Value =
ThisWorkbook.Sheets(nom_onglet_dest).Cells(6, 4).Value =



'Fermeture du classeur source
Workbooks(Fichier).Close False

'Confirmation de l'exportation
MsgBox "Chargement des données réussi"

End Sub
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
7 mai 2017 à 10:23
Bonjour Barrym, bonjour le forum,

Essaie comme ça :

Sub Copier_GOST()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim Fichier As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OV(1 To 3) As Worksheet 'déclare le tableau des trois variables OV (Onglet des Voiles)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim F As Byte 'déclare la variable F (Fois)
Dim I As Integer 'déclare la variable I (Incrément)
Dim Mi As Variant 'déclare la variable Mi (Minimum)
Dim Ma As Variant 'déclare la variable Ma (Maximum)

Application.ScreenUpdating = False 'masque les rafraîchissemnents d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("DS") 'définit l'onglet destination OD
'Ouverture fenêtre de selection du fichier d'entrée
Fichier = Application.GetOpenFilename
Workbooks.Open Filename:=Fichier
Set CS = ActiveWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Fond") 'définit l'onglet source OS
Set OV(1) = CS.Worksheets("RDC") 'définit l'onglet OV(1)
Set OV(2) = CS.Worksheets("R+1") 'définit l'onglet OV(2)
Set OV(3) = CS.Worksheets("R+2") 'définit l'onglet OV(3)
'Copie données fondations
OD.Range("Taux_travail_sol").Value = OS.Cells(665, 13).Value
OD.Range("Type_fondations").Value = OS.Cells(665, 11).Value
OD.Range("Type_plancher_bas").Value = OS.Cells(665, 10).Value
Set OS = CS.Worksheets("Infra") 'redéfinit l'onglet source
'Copie des données générales de l'onglet "Infra" vers l'onglet "DS"
OD.Range("TU_coffrage_voile_infra").Value = OS.Range("TU_cof_voile").Value
OD.Range("TU_coffrage_doka_infra").Value = OS.Range("TU_cof_doka").Value
'Copie données hauteurs de voile
For F = 1 To 3 'boucle 1 : 3 fois (sur les 3 onglets des voiles)
    Mi = 1000: Ma = 0 'initialise les variables Mi et Ma
    Set OS = OV(F) 'définit l'onglet de la boucle
    TV = OS.Range("C2").CurrentRegion 'définit le tableau des valeurs TV
    For I = 3 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
        If TV(I, 1) <> "" Then 'condition : si la donnée ligne I colonne 1 de TV n'est pas vide
            If TV(I, 2) < Mi Then Mi = TV(I, 2) 'définit la valeur minimum Mi
            If TV(I, 2) > Ma Then Ma = TV(I, 2) 'définit la valeur maximum Ma
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    OD.Cells(F + 3, 3).Value = Mi 'renvoie dans la cellule ligne F+3, colonne 3 de l'onglet OD la variable Mi
    OD.Cells(F + 3, 4).Value = Ma 'renvoie dans la cellule ligne F+3, colonne 4 de l'onglet OD la variable Ma
Next F 'prochaine fois de la boucle 1
CS.Close False 'ferme le classeur source
Application.ScreenUpdating = True 'affiche les rafraîchissemnents d'écran
MsgBox "Chargement des données réussi" 'Confirmation de l'exportation
End Sub

0
barrym78 Messages postés 7 Date d'inscription vendredi 5 mai 2017 Statut Membre Dernière intervention 16 mai 2017 2
9 mai 2017 à 11:14
Bonjour ThauTheme,

Je te remercie beaucoup pour cette réponse détaillée. J'ai finalement compris le principe et le programme fonctionne à merveille ;) !
0