Additionner des pieds et des pouces
Page modifiée le 29/04/2013
Il faut pour cela utiliser une fonction personnalisée comme celle-ci, à placer dans un module standard de ton classeur.
Function PiedsPlusPouces(mesure1 As String, mesure2 As String, Optional code As Byte) As Variant
'Clément Marcotte
'Amos (Québec)
'Avril 2005
'code = 1 ou omis : valeur numérique
'code = 2 : valeur texte
'prend deux mesures exprimées sous la forme
'de pieds - pouces - fractions de pouces
'(mesure1 et mesure2) et les
'additionne.
'Le code est optionnel et permet de choisir
'un affichage Pieds - Pouces - fractions au
'format texte dans Excel ou un affichage au
'format décimal dans Excel
'Application.Volatile
Dim numerateur As Variant, numerateur1 As Variant
Dim numerateur2 As Variant, denominateur1 As Variant
Dim denominateur As Variant, denominateur2 As Variant
Dim lespieds As Long, lespouces As Variant
Dim pasfractionbas As Boolean, pasfractionhaut As Boolean
Dim lespiedsbas As Long, lespiedshaut As Long
Dim lespoucesbas As Variant, lespouceshaut As Variant
Dim positionpieds1 As Byte
Dim match As Object, matches As Object, reste As Integer
Dim i As Byte
Dim re As Object, lafraction As Variant
Dim partiegauche As Variant, partiedroite As Variant
'Utiliser l'Objet Regexp de VBScript pour
'rechercher les symboles d'unités
Set re = CreateObject("VBScript.RegExp")
'Définir la chaîne de recherche
re.Pattern = ("pieds|pi|'|pouces|po|"|/")
'Ne pas tenir compte de la casse
re.ignorecase = True
'Sur tout le contenu de la cellule
re.Global = True
'un passage pour chaque donnée
For i = 1 To 2
Select Case i
Case 1
pasfractionbas = True
'Première donnéee
Set matches = re.Execute(mesure1)
For Each match In matches
Select Case UCase(match.Value)
Case "PI", "PIEDS", Chr(39)
lespiedsbas = CLng(LTrim(RTrim(Left(mesure1, match.firstindex))))
positionpieds1 = match.firstindex + match.Length + 1
Case "PO", "POUCES", Chr(34)
lespoucesbas = CLng(LTrim(RTrim(Mid(mesure1, positionpieds1, match.firstindex - positionpieds1 + 1))))
positionpieds1 = match.firstindex + match.Length
Case "/"
pasfractionbas = False
lafraction = Right(mesure1, Len(mesure1) - positionpieds1)
positionpieds1 = InStr(lafraction, "/")
partiegauche = LTrim(RTrim(Left(lafraction, positionpieds1 - 1)))
partiedroite = LTrim(RTrim(Right(lafraction, Len(lafraction) - positionpieds1)))
Select Case code
Case Is < 2
lespoucesbas = lespoucesbas + CDbl(partiegauche) / CDbl(partiedroite)
Case Else
numerateur1 = CDbl(partiedroite) * lespoucesbas + CDbl(partiegauche)
denominateur1 = partiedroite
lespoucesbas = CStr(numerateur1 & "/" & denominateur1)
End Select
Case Else
End Select
Next
Set matches = Nothing
Set match = Nothing
Case 2
pasfractionhaut = True
'Deuxième donnée
Set matches = re.Execute(mesure2)
For Each match In matches
Select Case UCase(match.Value)
Case "PI", "PIEDS", Chr(39)
lespiedshaut = CLng(LTrim(RTrim(Left(mesure2, match.firstindex))))
positionpieds1 = match.firstindex + match.Length + 1
Case "PO", "POUCES", Chr(34)
lespouceshaut = CLng(LTrim(RTrim(Mid(mesure2, positionpieds1, match.firstindex - positionpieds1 + 1))))
positionpieds1 = match.firstindex + match.Length
Case "/"
pasfractionhaut = False
lafraction = Right(mesure2, Len(mesure2) - positionpieds1)
positionpieds1 = InStr(lafraction, "/")
partiegauche = LTrim(RTrim(Left(lafraction, positionpieds1 - 1)))
partiedroite = LTrim(RTrim(Right(lafraction, Len(lafraction) - positionpieds1)))
Select Case code
Case Is < 2
lespouceshaut = lespouceshaut + CDbl(partiegauche) / CDbl(partiedroite)
Case Else
numerateur2 = CDbl(partiedroite) * lespouceshaut + CDbl(partiegauche)
denominateur2 = partiedroite
lespouceshaut = CStr(numerateur2 & "/" & denominateur2)
End Select
Case Else
End Select
Next
Case Else
End Select
Next
Select Case code
Case Is < 2
'Avec sortie numérique
lespouces = CDbl(lespoucesbas) + CDbl(lespouceshaut)
lespieds = CDbl(lespiedsbas) + CDbl(lespiedshaut)
If lespouces > 12 Then
lespieds = lespieds + (lespouces \ 12)
lespouces = (lespouces - (lespouces \ 12) * 12)
End If
lespouces = lespouces / 12
PiedsPlusPouces = CDbl(lespieds + lespouces)
Case Else
If denominateur1 Then
denominateur1 = CDbl(denominateur1)
End If
If denominateur2 Then
denominateur2 = CDbl(denominateur2)
End If
If numerateur2 Then
numerateur2 = CDbl(numerateur2)
End If
If numerateur1 Then
numerateur1 = CDbl(numerateur1)
End If
'Avec sortie au format texte
If denominateur1 > denominateur2 Then
reste = 1
If pasfractionhaut = False Then
reste = denominateur1 Mod denominateur2
End If
If reste = 0 Then
'Le dénominateur de la fraction
'de la première distance est plus
'élevé que celui de la fraction de la
'seconde distance et le premier est divisible
'sans reste par le second
denominateur = denominateur1
numerateur2 = denominateur1 / denominateur2 * numerateur2
ElseIf pasfractionhaut Then
'La deuxième donnée n'a pas
'de partie fractionnaire
'mais la première en a une
'Le dénominateur est donc
'celui de la première donnée
'et les pouces de la deuxième donnée
'sont ajustés en conséquence
denominateur = denominateur1
numerateur2 = denominateur1 * lespouceshaut
Else
'Le dénominateur de la fraction
'de la première distance est plus
'élevé que celui de la fraction de la
'seconde distance et le premier
'n'est pas divisible
'sans reste par le second
If Len(denominateur2) > 0 Then
denominateur = denominateur1 * denominateur2
numerateur2 = denominateur1 * numerateur2
numerateur1 = denominateur2 * numerateur1
Else
denominateur = denominateur1
End If
End If
Else
reste = 1
If pasfractionbas = False Then
reste = denominateur2 Mod denominateur1
End If
If reste = 0 Then
'Le dénominateur de la fraction
'de la deuxième distance est plus
'élevé que celui de la fraction de la
'seconde distance est divisible
'sans reste par la première
denominateur = denominateur2
numerateur1 = denominateur2 / denominateur1 * numerateur1
ElseIf pasfractionbas Then
'La première donnée n'a pas
'de partie fractionnaire
'mais la seconde en a une
'Le dénominateur est donc
'celui de la seconde donnée
'et les pouces de la première donnée
'sont ajustés en conséquence
denominateur = denominateur2
numerateur1 = denominateur2 * lespoucesbas
Else
'Le dénominateur de la fraction
'de la seconde distance est plus
'élevé que celui de la fraction de la
'première distance et le premier
'n'est pas divisible
'sans reste par le second
denominateur = denominateur1 * denominateur2
numerateur2 = denominateur / denominateur2 * numerateur2
numerateur1 = denominateur / denominateur1 * numerateur1
End If
End If
numerateur = numerateur2 + numerateur1
If Len(denominateur) > 0 Then
lespouces = numerateur / denominateur
Else
lespouces = CDbl(lespoucesbas) + CDbl(lespouceshaut)
End If
lespieds = CLng(lespiedsbas) + CLng(lespiedshaut)
If lespouces > 12 Then
lespieds = lespieds + (lespouces \ 12)
lespouces = (lespouces - (lespouces \ 12) * 12)
End If
If Len(denominateur) > 0 Then
lafraction = CStr((lespouces - Int(lespouces)) * denominateur) & "/" & denominateur
End If
lespouces = Int(lespouces)
PiedsPlusPouces = lespieds & " pieds " & lespouces & " pouces " & lafraction
End Select
Set re = Nothing
Set match = Nothing
Set matches = Nothing
numerateur1 = 0
numerateur2 = 0
denominateur1 = 0
denominateur2 = 0
End Function
Astuce illustrée par ce classeur
cm-piedspouces
Page modifiée le 29/04/2013
- Connectez-vous ou inscrivez-vous pour publier un commentaire
- 549 lectures

Commentaires récents