macro pour prendre qu'une partie de la cellule + une autre pour avoir la cellule de l'intersection.

[Loc3007]

Bonjour,

J'utilise une macro qui permet de récupérer des valeurs sur d'autre classeur, et de prendre les plus grandes valeur dans une plage défini.
Mes soucis, j'aimerai qu'il prenne que la 1er partie du texte de la cellule ex : 10/05/2017 à 00:00 --> 10/05/2017.
Pour mon 2nd problème, quand il me trouve la grande valeur sur la feuille, je voudrais qu'il me donne le créneau horaire de la ligne L5 (voir jpg), et que cette donnée apparaissent dans le 1er classeur récap.
Et pour finir, dans mon tableau il faudrait qu'il prennent que les valeurs des lignes (L6, L10, L14, L18,L22,L26 et L30).
Je vous remercie pour vos futur réponse.

Voici le code que j'utilise :

Sub consolide()

ChDir ActiveWorkbook.Path
Set recap_DELAM = ActiveWorkbook

Application.ScreenUpdating = False
compteur = 4

nf = Dir("*.xls")
Do While nf <> ""
If nf <> recap_DELAM.Name Then
Workbooks.Open Filename:=nf
Set WBOpened = ActiveWorkbook
With WBOpened
With .Sheets("Synthèse")

recap_DELAM.Sheets(1).Cells(compteur, 7) = .Range("E3").Value
recap_DELAM.Sheets(1).Cells(compteur, 10) = .Range("E4").Value
End With
With .Sheets("Débit Horaire (2)")
.Activate
recap_DELAM.Sheets(1).Cells(compteur, 11) = Application.WorksheetFunction.Max(Range("C6:$N30"))
recap_DELAM.Sheets(1).Cells(compteur, 13) = Application.WorksheetFunction.Max(Range("O6:$Z30"))
End With
End With
compteur = compteur + 1
Workbooks(nf).Close False
End If
nf = Dir
Loop
Application.ScreenUpdating = True
End Sub

 

[Staple1600]

Bonjour le fil, le forum

@Loc3007 [Bienvenue sur le forum]
En guise d'illustration et donc à adapter à ta problématique

Sub test_illustratif()
'//////////////////////////////////////////////////:
'CODE VBA juste pour créér le test
With Range("A1:A5")
.Value = "=NOW()+ROW()"
.NumberFormat = "dd/mm/yyyy """""" à """"""hh:mm"
.Value = .Value
End With
'fin CODE VBA création
'/////////////////////////////////////////////////:

For Each r In Range("A1:A5")
    part1 = Split(r.Text, " à ")(0)
    MsgBox part1
    part2 = Split(r.Text, " à ")(1)
    MsgBox part2
Next
End Sub

 

[mapomme]

Bonjour Loc3007, @Staple1600 ,

Une autre façon :

For Each r In Range("A1:A5")
   part1 = Format(r, "dd/mm/yyyy")
   MsgBox part1
   part2 = Format(r, "hh:nn:ss")
   MsgBox part2
Next

 

[Staple1600]

Bonjour maponne

@mapomme
(cf ton code =>part2)
EDITION: je viens de voir que le neuneu fonctionne comme format

Spoiler: Montre moi la voie, mapomme ;)

Tu peux m'expliquer c'est quoi cette bouteille de format ,

Sub a()
Dim r As Range
Set r = [A1]: r = "16/05/2017 à 23:00"
part1 = Format(r, "dd/mm/yyyy")
MsgBox part1
part2 = Format(r, "hh:nn:ss")
MsgBox part2
'par contre avec une vraie date, ok
r.Clear: r = Now
part1 = Format(r, "dd/mm/yyyy")
MsgBox part1
part2 = Format(r, "hh:nn:ss") & "|" & Format(r, "hh:mm:ss")
MsgBox part2
End Sub

PS: Dans le fichier exemple de Loc3607 (colonne E,feuille Synthèse)
le format est Standard
D'ou l'emploi de Split
Car ton code ne "fonctionne" pas
Sub z()
Set r = ActiveCell
part1 = Format(r, "dd/mm/yyyy")
MsgBox part1
part2 = Format(r, "hh:mm:ss")
MsgBox part2
End Sub

 

[Loc3007]

Bonjour,

Je vous remercie pour vos réponse, j'ai incrusté votre code dans la 1er macro, par contre j'ai un problème elle ne marche pas correctement.
Je suis novice en programmation, je pense que je fais pas les chose correctement.
Ainsi pouvez-vous m'indiquer ou je me trompe.

En vous remerciant.



Sub consolide()

ChDir ActiveWorkbook.Path
Set recap_DELAM = ActiveWorkbook

Application.ScreenUpdating = False
compteur = 4

nf = Dir("*.xls")
Do While nf <> ""
If nf <> recap_DELAM.Name Then
Workbooks.Open Filename:=nf
Set WBOpened = ActiveWorkbook
With WBOpened
With .Sheets("Synthèse")

recap_DELAM.Sheets(1).Cells(compteur, 7) = .Range("E3").Value
recap_DELAM.Sheets(1).Cells(compteur, 10) = .Range("E4").Value
Sub test_illustratif()
'//////////////////////////////////////////////////:
'CODE VBA juste pour créér le test
With Range("A1:A5")
.Value = "=NOW()+ROW()"
.NumberFormat = "dd/mm/yyyy """""" à """"""hh:mm"
.Value = .Value
End With
'fin CODE VBA création
'/////////////////////////////////////////////////:

For Each r In Range("A1:A5")
part1 = Split(r.Text, " à ")(0)
MsgBox part1
part2 = Split(r.Text, " à ")(1)
MsgBox part2
Next
End Sub


End With
With .Sheets("Débit Horaire (2)")
.Activate
recap_DELAM.Sheets(1).Cells(compteur, 11) = Application.WorksheetFunction.Max(Range("C6:$N30"))
recap_DELAM.Sheets(1).Cells(compteur, 13) = Application.WorksheetFunction.Max(Range("O6:$Z30"))
End With
End With
compteur = compteur + 1
Workbooks(nf).Close False
End If
nf = Dir
Loop
Application.ScreenUpdating = True
End Sub

 

[Lone-wolf]

Bonsoir Loc, Jean Marie, mapomme

@Loc3007

Copie la macro si dessous

    Sub consolide()

    ChDir ActiveWorkbook.Path
    Set recap_DELAM = ActiveWorkbook

    Application.ScreenUpdating = False
    compteur = 4

    nf = Dir("*.xls")
    Do While nf <> ""
    If nf <> recap_DELAM.Name Then
    Workbooks.Open Filename:=nf
    Set WBOpened = ActiveWorkbook

    With WBOpened.Sheets("Synthèse")

    recap_DELAM.Sheets(1).Cells(compteur, 7) = .Range("E3").Value
    recap_DELAM.Sheets(1).Cells(compteur, 10) = .Range("E4").Value

   'SI TU VEUX QUE LA DATE
    With .Range("A1:A5")
    .NumberFormat = "dd/mm/yyyy """""" à """"""hh:mm"
    End With

    For Each r In .Range("A1:A5")
    part1 = Split(r.Text, " à ")(0)
    'Workbooks(nf).Name = part1  'mais suis pas sûr
    Next
    End With

    With .Sheets("Débit Horaire (2)")
    .Activate
    recap_DELAM.Sheets(1).Cells(compteur, 11) = Application.WorksheetFunction.Max(Range("C6:$N30"))
    recap_DELAM.Sheets(1).Cells(compteur, 13) = Application.WorksheetFunction.Max(Range("O6:$Z30"))
    End With
    compteur = compteur + 1
    Workbooks(nf).Close False
    End If
    nf = Dir
    Loop
End Sub