[excel] petite routine

Bonjour,

Voila une petite macro qui devrait te permettre de faire ca:

'selection de la feuille de travail
Sheets(Feuil1.Name).Select
With Sheets(Feuil1.Name)

introw = 2
'boulce tant que cellule non vide
Do Until ActiveSheet.Cells(introw, 1).Value = ""
'test contenu case
If ActiveSheet.Cells(introw, 1).Value = X Then
ActiveSheet.Cells(introw, 2).Value = "1500"
ActiveSheet.Cells(introw, 3).Value = "1000"
ActiveSheet.Cells(introw, 4).Value = "30"
ActiveSheet.Cells(introw, 5).Value =ActiveSheet.Cells(introw, 2).Value * ActiveSheet.Cells(introw, 3).Value * ActiveSheet.Cells(introw, 4).Value
End If
introw = introw + 1
Loop

Merci de ta réponse rapide;

Je la teste de suite.

Ceci étant, les valeurs de ma cellule que j'ai cité (1500, 1000 et 30) sont arbitraires...

++

pour faire simple, les lignes successives sont de ce type :

1500 X 1000 X 30
500 X 200 X 10
1500 X 500 X 20
plaque ep10
tube PHI50
500 X 500 X 15

Je veux donc avoir un résultat du type :

1500 1000 30 4.5E7
500 200 10 1E6
1500 500 20 1.5E7
"VIDE"
"VIDE"
500 500 15 3.75E6

Je pense que pour ton cas il faudrais mettre la longueur la largeur et la profondeur dans 3 colonne differentes...
sinon ca devient difficile et fastidieu de recuperer chaque nombre un a un...

D'accord avec toi xavier;

Ceci étant, je travaille à partir d'un fichier excel récupéré de plus de 1000 lignes qui contient toutes les données déjà à ce format...

Donc c'est mort pour recopier dans 3 cellules différentes ces 3 données...

Alors a ce moment la pr recuperer les infos separer dans chaque cellule pour faire le calcul a mon avis...
il faut utiliser successivement la fonction InStr InStrRev pui Mid :/
InStr(activesheet.Cells(...)," ") qui te renvoi la position du premier espace
InStrRev(activesheet.Cells(...)," ") qui te renvoi la position du dernier espace
et ensuite un Mid qui te permet de couper ta chaine de caracter mais ca parait complexe quand meme...
sinon je vois pas comment faire desole!

Quelqu'un vient de me suggérer d'utiliser simplement ces 2 fonctions :

CHERCHE pour indexer la position des "X"

STXT pour recopier la chaîne de caractère indéxé part les valeurs précédentes

c'est simple et ça marche niquel;

++

voilà ta routine toute faite
j'ai supposé qu'il y avait une ligne de titre et que ta feuille s'appelle "feuil1"
j'ai écrit une formule en colonne D mais situ préfères un calcul direct c'est possible.
recopie cette procédure dans un module
Les Lignes qui ne contiennent pas de "X" ne sont pas traitées.

Sub calcul_du_volume()

' on travaille sur la feuil n°1 qui s'appelle "feuil1"
' je suppose qu'il y a un ligne de titre
' je commence en "A2"
Dim NbLigne As Integer
Dim C As Variant
Dim Chaine1 As String
Dim Chaine2 As String
Dim Chaine3 As String

Sheets("feuil1").Select
Range("A2").Select
'je compte le nombre de ligne
NbLigne = Range("a2").CurrentRegion.Rows.Count

For Each C In Range("a2:a" & NbLigne + 1)

If InStr(1, C, "X") > 0 Then
Chaine1 = Left(C, InStr(1, C, "X") - 1)
Chaine2 = Mid(C, InStr(1, C, "X") + 1, InStr(InStr(1, C, "X"), C, "X"))
Chaine3 = Right(C, Len(C) - (Len(Chaine1) + Len(Chaine2) + 2))

Else
'ne contient pas le charactère "X"
End If

'on supprime les espaces
Chaine1 = Trim(Chaine1)
Chaine2 = Trim(Chaine2)
Chaine3 = Trim(Chaine3)
'on écrit le résultat en valeur
C.Offset(0, 1).Value = Val(Chaine1) ' en colonne b
C.Offset(0, 2).Value = Val(Chaine2) 'en colonne c
C.Offset(0, 3).Value = Val(Chaine3)
'on écrit une formule de calcul

C.Offset(0, 4).FormulaR1C1 = "=RC[-3]*RC[-2]*RC[-1]"

Next

End Sub

j'ai ajouté la gestion pour obtenir "VIDE"
je n'avais pas lu toute ta demande désolé
pour le format tu fais click sur format cellule nombre et tu choisis ce qui te convient.

Sub calcul_du_volume()

' on travaille sur la feuil n°1 qui s'appelle "feuil1"
' je suppose qu'il y a un ligne de titre
' je commence en "A2"
Dim NbLigne As Integer
Dim C As Variant
Dim Chaine1 As String
Dim Chaine2 As String
Dim Chaine3 As String

Sheets("feuil1").Select
Range("A2").Select
'je compte le nombre de ligne
NbLigne = Range("a2").CurrentRegion.Rows.Count

For Each C In Range("a2:a" & NbLigne + 1)

If InStr(1, C, "X") > 0 Then
Chaine1 = Left(C, InStr(1, C, "X") - 1)
Chaine2 = Mid(C, InStr(1, C, "X") + 1, InStr(InStr(1, C, "X"), C, "X"))
Chaine3 = Right(C, Len(C) - (Len(Chaine1) + Len(Chaine2) + 2))

Else
'ne contient pas le charactère "X"
C.Offset(0, 4).Value = "VIDE"
End If

'on supprime les espaces
Chaine1 = Trim(Chaine1)
Chaine2 = Trim(Chaine2)
Chaine3 = Trim(Chaine3)
'on écrit le résultat en valeur
C.Offset(0, 1).Value = Val(Chaine1) ' en colonne b
C.Offset(0, 2).Value = Val(Chaine2) 'en colonne c
C.Offset(0, 3).Value = Val(Chaine3)
'on écrit une formule de calcul

C.Offset(0, 4).FormulaR1C1 = "=RC[-3]*RC[-2]*RC[-1]"

Next

End Sub