Salut,
Un petit problème de virgule et de point ! La semaine dernière kjin m’a crée un code pour automatiser la mise en page d’un tableau (encore merci bcp).
Aujourd’hui j’ai juste un problème au niveau des chiffres où nous avons remplacé les points par des virgules sauf qu’après l’exécution du code les chiffres ne sont pas reconnus ! et je ne peux pas effectuer des calculs sur ces montants.
Je ne vois pas comment faire ? Avez-vous une idée ?
Merci,
Ci-joint le code :
Sub EffaceRecopie()
Dim k As Integer, i As Integer, j As Integer 'déclaration des variables
Application.ScreenUpdating = False 'désactivation du rafraichissement d'écran
Rows("1:8").Delete 'effacement lignes 1 à 8
For k = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 'boucle n° de la dernière ligne de la feuille jusqu'à 2
If Cells(k, 13) <> "M" And Cells(k, 13) <> "F" Then Rows(k).Delete 'si valeur col M ligne k on supprime la ligne
Next k 'n° ligne suivant
For i = 1 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count 'boucle n° de la dernière ligne de la plage jusqu'à 2
For j = 1 To 8 'boucle n° colonne 1 à 8
If Cells(i, j) = "" Then Cells(i, j) = Cells(i - 1, j) 'si cel vide on copie la valeur de la cel précédente
Next j 'n° colonne suivant
Range("I" & i & ":K" & i).Replace What:=".", Replacement:=",", LookAt:=xlPart 'remplacement "." par "," col I,J,K
Range("N" & i) = Format(Date, "mm/dd/yyyy") 'col N = date du jour
Next i 'n° ligne suivant
Range("N1") = "DATE" 'texte cellule N1
ActiveSheet.Shapes("Bouton 1").Delete 'la macro effaçant les 8 première lignes je préfère supprimer le bouton
Application.ScreenUpdating = True 'réactivation du rafraichissement d'écran
End Sub
Un petit problème de virgule et de point ! La semaine dernière kjin m’a crée un code pour automatiser la mise en page d’un tableau (encore merci bcp).
Aujourd’hui j’ai juste un problème au niveau des chiffres où nous avons remplacé les points par des virgules sauf qu’après l’exécution du code les chiffres ne sont pas reconnus ! et je ne peux pas effectuer des calculs sur ces montants.
Je ne vois pas comment faire ? Avez-vous une idée ?
Merci,
Ci-joint le code :
Sub EffaceRecopie()
Dim k As Integer, i As Integer, j As Integer 'déclaration des variables
Application.ScreenUpdating = False 'désactivation du rafraichissement d'écran
Rows("1:8").Delete 'effacement lignes 1 à 8
For k = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 'boucle n° de la dernière ligne de la feuille jusqu'à 2
If Cells(k, 13) <> "M" And Cells(k, 13) <> "F" Then Rows(k).Delete 'si valeur col M ligne k on supprime la ligne
Next k 'n° ligne suivant
For i = 1 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count 'boucle n° de la dernière ligne de la plage jusqu'à 2
For j = 1 To 8 'boucle n° colonne 1 à 8
If Cells(i, j) = "" Then Cells(i, j) = Cells(i - 1, j) 'si cel vide on copie la valeur de la cel précédente
Next j 'n° colonne suivant
Range("I" & i & ":K" & i).Replace What:=".", Replacement:=",", LookAt:=xlPart 'remplacement "." par "," col I,J,K
Range("N" & i) = Format(Date, "mm/dd/yyyy") 'col N = date du jour
Next i 'n° ligne suivant
Range("N1") = "DATE" 'texte cellule N1
ActiveSheet.Shapes("Bouton 1").Delete 'la macro effaçant les 8 première lignes je préfère supprimer le bouton
Application.ScreenUpdating = True 'réactivation du rafraichissement d'écran
End Sub
Pièces jointes
Dernière édition: