Macro pour supprimer la date dans plage de cellule
Bonjour ,
Je suis à la recherche d'une macro qui me servirait à supprimer la date de plusieurs dans un tableau de donnée et ne garder que l'heure .
exemple : 29/08/2016 10:30:00
résultat: 10:30
si quelqu'un à ça je suis preneur , merci merci
fichier : onglet data
Bonjour,
pas besoin de macro tu change juste le format d'affichage de ta cellule .. voir menu format affichage..
merci mais de ce que j'ai vu le format d'affichage ne supprime pas la date mais la cache seulement , j 'ai besoin qu'elle disparaisse entièrement , pour pouvoir ensuite extraire via une macro les donnée vers un autre tableau ( voir fichier)
merci
Montre nous ton code d'extraction ..
PS : je n'ouvrirais pas la pièce jointe pour si peu..
voila ,
Sub test()
tablo = Sheets("PLANNING").Range("A1").CurrentRegion.Resize(Sheets("PLANNING").Range("A" & Rows.Count).End(xlUp).Row)
tabdata = Sheets("DATA").Range("A1").CurrentRegion
For n = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(n, 1) = "AM" Or tablo(n, 1) = "PM" Then
If tablo(n, 1) = "AM" Then
debhor = CDate("8:00")
finhor = CDate("12:00")
Else
debhor = CDate("13:00")
finhor = CDate("23:00")
End If
For m = n To LBound(tablo, 1) Step -1
If tablo(m, 1) <> "AM" And tablo(m, 1) <> "PM" Then
dpt = tablo(m - 1, 1)
Exit For
End If
Next
For p = LBound(tabdata, 1) + 1 To UBound(tabdata, 1)
For q = LBound(tabdata, 2) + 9 To UBound(tabdata, 2)
If tabdata(p, q) <> "" Then
If tabdata(p, 2) = dpt And CDate(tabdata(p, q)) >= debhor And CDate(tabdata(p, q)) <= finhor Then
For s = LBound(tablo, 2) To UBound(tablo, 2)
If UCase(tablo(1, s)) = UCase(tabdata(1, q)) Then
tablo(n, s) = tablo(n, s) & Trim(tabdata(p, 1)) & Chr(10)
End If
Next
End If
End If
Next
Next
End If
Next
Sheets("PLANNING").Range("A1").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
For n = Sheets("PLANNING").Range("A" & Rows.Count).End(xlUp).Row To 7 Step -1
For m = 2 To Sheets("PLANNING").Cells(1, Columns.Count).End(xlToLeft).Column
If Sheets("PLANNING").Cells(n, m) = Sheets("PLANNING").Cells(n - 1, m) And Sheets("PLANNING").Cells(n, m).Interior.Color = Sheets("PLANNING").Cells(n - 1, m).Interior.Color Then
Sheets("PLANNING").Cells(n, m) = ""
End If
Next
Next
For n = Sheets("PLANNING").Range("A" & Rows.Count).End(xlUp).Row To 7 Step -1
For m = 2 To Sheets("PLANNING").Cells(1, Columns.Count).End(xlToLeft).Column
x = Sheets("PLANNING").Cells(n, m)
If x <> "" Then
Sheets("PLANNING").Cells(n, m) = Left(x, Len(x) - 1)
End If
Next
Next
End Sub
Pas tout le code .. juste la ligne de copie de ta date ..