Pb arrondi
Bonjour le Forum,
dans une macro, je récupère les valeurs numériques de cellules d'une feuille que je copie dans une autre feuille du même classeur.
Mais sur la copie, j'ai des valeurs arrondies.
Par ex: sur la feuille d'origine j'ai 1.50, mais la copie me donne 2.00?
Quelqu'un peut m'expliquer la raison?
Bonjour,
Peut-être en voyant la macro
bonjour
parfois ,c'est une simple histoire de largeur de colonne
cordialement
Le plus probable est une histoire de "cast"
Par exemple, je déclare la variable i comme un entier.
Bonsoir,
voici la macro "en cause"
Pour résumé:
je crée une feuille "Feuill1" dans laquelle je copie des colonnes de la "S03".
Je fais "un peu de nettoyage", puis en fonction des valeurs de ces cellules je récupère des heures
en fonction de la couleur de fond de cellule et si la valeur numérique est souligné.
C'est là ou le bas blesse car je récupère bien les bonnes valeurs mais arrondies.
Je vais essayer d'envoyer un fichier mais c'est un fichier avec des données personnelles que je dois
simplifier.
Sub Macro1()
Application.ScreenUpdating = False
Dim Cel As Range
'copie des colonnes commandes
Sheets.Add.Name = "Feuil1"
'copie du lundi
Sheets("S03").Select
Range("C6:C77").Select
Selection.Copy
Sheets("Feuil1").Select
Range("B1").Select
ActiveSheet.Paste
'copie du mardi
Sheets("S03").Select
Range("E6:E77").Select
Selection.Copy
Sheets("Feuil1").Select
x = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
'MsgBox x
Range("B" & x + 1).Select
ActiveSheet.Paste
'copie du mercredi
Sheets("S03").Select
Range("G6:G77").Select
Selection.Copy
Sheets("Feuil1").Select
x = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
'MsgBox x
Range("B" & x + 1).Select
ActiveSheet.Paste
'copie du jeudi
Sheets("S03").Select
Range("I6:I77").Select
Selection.Copy
Sheets("Feuil1").Select
x = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
'MsgBox x
Range("B" & x + 1).Select
ActiveSheet.Paste
'copie du vendredi
Sheets("S03").Select
Range("K6:K77").Select
Selection.Copy
Sheets("Feuil1").Select
x = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Range("B" & x + 1).Select
ActiveSheet.Paste
'suppression couleur fond
Columns("B:B").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("B1:B295")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'supprime les bordures
ActiveWindow.SmallScroll Down:=105
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Suppression des doublons
Columns("B:B").Select
ActiveSheet.Range("$B$1:$B$150").RemoveDuplicates Columns:=1, Header:=xlNo
'mise à dimension colonne
Columns("B:B").EntireColumn.AutoFit
'suppression des lignes lorsque / n'est pas trouvé dans la cellule
x = Cells.Find("/", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
For i = 1 To x
If InStr(Range("B" & i).Value, "/") = 0 Then '
Range("B" & i).EntireRow.Delete
End If
Next
'recherche des heures dans la semaine demandée
x = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
MsgBox "Nombre de ligne de commande à traiter : " & x
For j = 1 To x
'remise à zero des compteurs
CompteurHeureDebit = 0
CompteurHeureUsi = 0
CompteurHeureSer = 0
CompteurHeureMon = 0
Commande = Range("B" & j).Value
'semaine de recherche
Sheets("S03").Select
'recherche des heures en fonction couleur de fond de la cellule et du souligné
For Each Cel In ActiveSheet.Range("A4:M73").Cells 'boucle sur les cellules A4:M65 de la semaine demandée
If Cel.Value = Commande And Cel.Offset(0, 1).Font.Underline = xlUnderlineStyleSingle And Cel.Offset(0, 1).Interior.ColorIndex = 43 Then
CompteurHeureDebit = Cel.Offset(0, 1).Value + CompteurHeureDebit ' somme des heures débit
ElseIf Cel.Value = Commande And Cel.Offset(0, 1).Font.Underline = xlUnderlineStyleSingle And Cel.Offset(0, 1).Interior.ColorIndex = 6 Then
CompteurHeureUsi = Cel.Offset(0, 1).Value + CompteurHeureUsi ' somme des heures usinage
ElseIf Cel.Value = Commande And Cel.Offset(0, 1).Font.Underline = xlUnderlineStyleSingle And Cel.Offset(0, 1).Interior.ColorIndex = 15 Then
CompteurHeureSer = Cel.Offset(0, 1).Value + CompteurHeureSer ' somme des heures usinage
ElseIf Cel.Value = Commande And Cel.Offset(0, 1).Font.Underline = xlUnderlineStyleSingle And Cel.Offset(0, 1).Interior.ColorIndex = 40 Then
CompteurHeureMon = Cel.Offset(0, 1).Value + CompteurHeureMon ' somme des heures montage
End If
Next
'inscription des heures par commande sur la feuille 1
Sheets("Feuil1").Select
Range("C" & j).Value = CompteurHeureDebit
Range("D" & j).Value = CompteurHeureUsi
Range("E" & j).Value = CompteurHeureSer
Range("F" & j).Value = CompteurHeureMon
Range("G" & j).Value = CompteurHeureDebit + CompteurHeureUsi + CompteurHeureSer + CompteurHeureMon
Next j
Application.ScreenUpdating = True
End Sub