XL pour MAC Additionner deux nombres d'une même cellule séparés par alt+enter

E

elodie.fc33

XLDnaute Nouveau
Bonjour,

Je dois additionner deux nombres inscrits dans une même cellule affichés en colonne (alt+enter) dans une colonne à droite
1799,00
2527,00

Je dois aussi coller chacun de ces nombres dans deux colonnes différentes, en sachant que ces nombres n'ont pas le même nombre de chiffres...

Attention, dans certaines cellules, il n'y a qu'un seul nombre...

Merci pour votre aide
 

Pièces jointes

  • Panier moyen test.xlsx
    203.4 KB · Affichages: 38
Trier par date Trier par votes
S

soan

XLDnaute Barbatruc
Inactif
Bonjour élodie,

bienvenue sur le site XLD ! :)

ton fichier en retour ; fais Ctrl e ➯ travail effectué ! 😊

VB: 
Sub Essai()
  If ActiveSheet.Name <> "ExportDetailsRetailes_2021-04-0" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim s$, c As String * 1, z As Byte, t, v1#, v2#, k%, i&
  Application.ScreenUpdating = 0
  For i = 2 To n
    With Cells(i, 1)
      s = .Value
      If s <> "" Then
        c = Left$(s, 1): k = IIf(c = "C", 3, 4): z = -(InStr(s, vbLf) > 0)
        If z = 0 Then
          v1 = .Offset(, 1)
          If v1 > 0 Then .Offset(, 2) = v1: .Offset(, k) = v1
        Else
          t = Split(.Offset(, 1), vbLf): v1 = t(0): v2 = t(1)
          If v1 > 0 Then .Offset(, k) = v1
          If v2 > 0 Then .Offset(, 7 - k) = v2
          v2 = v1 + v2: If v2 > 0 Then .Offset(, 2) = v2
        End If
      End If
    End With
  Next i
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • Panier moyen test.xlsm
    214.4 KB · Affichages: 9
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc

elodie.fc33 à dit:
Bonjour,

Je dois additionner deux nombres inscrits dans une même cellule affichés en colonne (alt+enter) dans une colonne à droite
1799,00
2527,00

Je dois aussi coller chacun de ces nombres dans deux colonnes différentes, en sachant que ces nombres n'ont pas le même nombre de chiffres...

Attention, dans certaines cellules, il n'y a qu'un seul nombre...

Merci pour votre aide
Cliquez pour agrandir...
Bonjour à tous,
Un essai par formule, si le séparateur décimale est la virgule
 

Pièces jointes

  • Panier moyen test V1.xlsx
    278.1 KB · Affichages: 17
Dernière édition:
Vote positif 0 Vote négatif
E

elodie.fc33

XLDnaute Nouveau
soan à dit:
Bonjour élodie,

bienvenue sur le site XLD ! :)

ton fichier en retour ; fais Ctrl e ➯ travail effectué ! 😊

VB: 
Sub Essai()
  If ActiveSheet.Name <> "ExportDetailsRetailes_2021-04-0" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim s$, c As String * 1, z As Byte, t, v1#, v2#, k%, i&
  Application.ScreenUpdating = 0
  For i = 2 To n
    With Cells(i, 1)
      s = .Value
      If s <> "" Then
        c = Left$(s, 1): k = IIf(c = "C", 3, 4): z = -(InStr(s, vbLf) > 0)
        If z = 0 Then
          v1 = .Offset(, 1)
          If v1 > 0 Then .Offset(, 2) = v1: .Offset(, k) = v1
        Else
          t = Split(.Offset(, 1), vbLf): v1 = t(0): v2 = t(1)
          If v1 > 0 Then .Offset(, k) = v1
          If v2 > 0 Then .Offset(, 7 - k) = v2
          v2 = v1 + v2: If v2 > 0 Then .Offset(, 2) = v2
        End If
      End If
    End With
  Next i
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
Cliquez pour agrandir...
Bonjour Soan,
Un grand MERCI! Ca marche et c'est exactement ce qu'il me fallait!
Je vais gagner un temps de dingue!!!
Est ce que j'abuse si je vous demande aussi celui ci?
J'ai essayé de comprendre la macro mais c'est trop complexe pour moi...:-(
Merci encore pour votre super aide!
Elodie
 

Pièces jointes

  • panier moyen 2eme .xlsx
    429.8 KB · Affichages: 5
Vote positif 0 Vote négatif
R@chid

R@chid

XLDnaute Barbatruc
Supporter XLD
Bonjour @ tous,
en C2 :
VB: 
=SOMMEPROD(FILTRE.XML("<a><b>"&SUBSTITUE(B2;CAR(10);"</b><b>")&"</b></a>";"//b"))
@ tirer vers le bas


En D2 :
Code: 
=SIERREUR(INDEX(FILTRE.XML("<a><b>"&SUBSTITUE($B2;CAR(10);"</b><b>")&"</b></a>";"//b");COLONNES($D:D));"")
@ valider par Ctrl+Maj+Entrée
@ tirer vers la droite puis vers le bas


Cordialement
 
Vote positif 0 Vote négatif
E

elodie.fc33

XLDnaute Nouveau
elodie.fc33 à dit:
Bonjour Jacky67,
Merci beaucoup pour ce retour. Je vais essayer de l'appliquer sur d'autres fichiers que j'ai.
Quoi qu'il en soit c'est tout à fait correct et très utile...sans compter le temps que cela me fait gagner!
Encore merci pour votre aide!
Belle soirée
Elodie
Cliquez pour agrandir...
Bonjour Jacky67,

J'ai essayé d'utiliser vos formules pour un autre fichier ci-joint mais cela ne marche pas car j'ai trois information dans ma cellule... Pourriez vous jeter un coup d'oeil à ce fichier? Merci par avance
Elodie
 

Pièces jointes

  • panier moyen 2eme .xlsx
    430.2 KB · Affichages: 8
Vote positif 0 Vote négatif
E

elodie.fc33

XLDnaute Nouveau
elodie.fc33 à dit:
Bonjour Soan,
Un grand MERCI! Ca marche et c'est exactement ce qu'il me fallait!
Je vais gagner un temps de dingue!!!
Est ce que j'abuse si je vous demande aussi celui ci?
J'ai essayé de comprendre la macro mais c'est trop complexe pour moi...:-(
Merci encore pour votre super aide!
Elodie
Cliquez pour agrandir...
Bonjour Soan
Pensez vous pouvoir jeter un oeil sur ce deuxième fichier "panier moyen 2eme"? Merci de nouveau pour votre précieuse aide
Elodie
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonjour Élodie,

tu as écrit dans ton post #4 : « Un grand MERCI ! Ça marche et c'est exactement ce qu'il me fallait ! » : merci pour ton retour ! 😊 j'ai aussi vu ton post #8 ; je suis en train de travailler sur ton 2ème fichier, ça va être bientôt prêt ! 😜
​
soan
 
Dernière édition:
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
@Élodie

ton 2ème fichier en retour ; même utilisation : fais Ctrl e ➯ travail effectué ! 😊

cerise sur le gâteau : regarde la ligne 10 que j'ai ajoutée : non seulement tu peux mettre en A10 4 items différents d'un seul coup (ce qui est normal vu qu'il y a en fait 4 colonnes "détail"), mais en plus t'es pas obligée de mettre ces 4 items dans le même ordre que celui des colonnes ; regarde bien attentivement : les montants ont été correctement répartis dans les colonnes adéquates : le 324,75 de "Salle de bains" en F10 ; le 148,12 de "Menuiseries" en D10 ; le 465,38 de "Verri√®res" en G10 ; et le 216,85 de "Carrelages" en E10 ; tu peux vérifier le total : 324,75 + 148,12 + 465,38 + 216,85 = 1 155,10 et en C10, c'est bien ce montant qui apparaît ; maintenant que tu as vu la jolie cerise, tu peux supprimer la ligne 10.​

VB: 
Sub Essai()
  If ActiveSheet.Name <> "ExportDetailsRetailes_2021-04-0" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim chn$, c As String * 1, z As Byte, t1, t2, v#, s#
  Dim m As Byte, k%, i&, j As Byte: Application.ScreenUpdating = 0
  i = Cells(Rows.Count, 3).End(3).Row: If i > 1 Then Range("C2:G" & i).ClearContents
  For i = 2 To n
    With Cells(i, 1)
      chn = .Value
      If chn <> "" Then
        c = Left$(chn, 1): k = 3 - (c = "C") - 2 * (c = "S") - 3 * (c = "V")
        z = -(InStr(chn, vbLf) > 0)
        If z = 0 Then
          v = .Offset(, 1)
          If v > 0 Then .Offset(, 2) = v: .Offset(, k) = v
        Else
          t1 = Split(chn, vbLf): t2 = Split(.Offset(, 1), vbLf): m = UBound(t1): s = 0
          For j = 0 To m
            c = Left$(t1(j), 1): k = 3 - (c = "C") - 2 * (c = "S") - 3 * (c = "V")
            v = t2(j): If v > 0 Then .Offset(, k) = v: s = s + v
          Next j
          If s > 0 Then .Offset(, 2) = s
        End If
      End If
    End With
  Next i
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • panier moyen 2eme.xlsm
    459.3 KB · Affichages: 7
Vote positif 0 Vote négatif
E

elodie.fc33

XLDnaute Nouveau
Merci Soan et bien vu pour le 4eme item! Je l'avais même pas vu!
Super boulot...pour moi c'est du génie!
Vraiment merci beaucoup pour ces fonctions qui vont me faire gagner du temps et qui sont très pertinentes pour moi.
Belle soirée :) et à ta dispo si je peux aider en quoi que ce soit (sauf en fonctions Excel...😂 )
Elodie
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonsoir Élodie,

tu as écrit : « Super boulot...pour moi c'est du génie! »

merci pour ton retour ! 😊 mais j'ai tout d'même oublié une petite optimisation :​

VB: 
Sub Essai()
  If ActiveSheet.Name <> "ExportDetailsRetailes_2021-04-0" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim chn$, c As String * 1, z As Byte, t1, t2, v#, s#
  Dim m As Byte, k%, i&, j As Byte: Application.ScreenUpdating = 0
  i = Cells(Rows.Count, 3).End(3).Row: If i > 1 Then Range("C2:G" & i).ClearContents
  For i = 2 To n
    With Cells(i, 1)
      chn = .Value
      If chn <> "" Then
        z = -(InStr(chn, vbLf) > 0)
        If z = 0 Then
          c = Left$(chn, 1): k = 3 - (c = "C") - 2 * (c = "S") - 3 * (c = "V")
          v = .Offset(, 1): If v > 0 Then .Offset(, 2) = v: .Offset(, k) = v
        Else
          t1 = Split(chn, vbLf): t2 = Split(.Offset(, 1), vbLf): m = UBound(t1): s = 0
          For j = 0 To m
            c = Left$(t1(j), 1): k = 3 - (c = "C") - 2 * (c = "S") - 3 * (c = "V")
            v = t2(j): If v > 0 Then .Offset(, k) = v: s = s + v
          Next j
          If s > 0 Then .Offset(, 2) = s
        End If
      End If
    End With
  Next i
End Sub

je te laisse comparer les 2 codes VBA pour trouver ce que j'ai modifié. 😜
voici quand même un indice : c'est entre If chn <> "" Then et Else

soan
 

Pièces jointes

  • panier moyen 2eme.xlsm
    459.4 KB · Affichages: 3
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonsoir Élodie,

j'ai refait entièrement tes 2 exos avec la méthode des tableaux, qui est bien plus performante : c'est vraiment très rapide, même sur plusieurs milliers de lignes ; l'utilisation est identique : fais Ctrl e

si tes fichiers réels comportent vraiment beaucoup de lignes, tu devrais pouvoir constater une amélioration très sensible de la vitesse d'exécution ! 😊​


code VBA du 1er fichier :

VB: 
Option Explicit

Private Function Ind(chn$) As Byte
  Dim c As String * 1: c = Left$(chn, 1): Ind = 4 - (c = "R")
End Function

Sub Essai()
  If ActiveSheet.Name <> "ExportDetailsRetailes_2021-04-0" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim T, chn$, z As Byte, t1, t2, v1#, v2#, s#, i&
  n = n - 1: T = [A2].Resize(n, 5): Application.ScreenUpdating = 0
  i = Cells(Rows.Count, 3).End(3).Row: If i > 1 Then Range("C2:E" & i).ClearContents
  For i = 1 To n
    chn = T(i, 1)
    If chn <> "" Then
      z = -(InStr(chn, vbLf) > 0)
      If z = 0 Then
        v1 = T(i, 2): If v1 > 0 Then T(i, 3) = v1: T(i, Ind(chn)) = v1
      Else
        t1 = Split(chn, vbLf): t2 = Split(T(i, 2), vbLf)
        v1 = t2(0): If v1 > 0 Then chn = t1(0): T(i, Ind(chn)) = v1
        v2 = t2(1): If v2 > 0 Then chn = t1(1): T(i, Ind(chn)) = v2
        s = v1 + v2: If s > 0 Then T(i, 3) = s
      End If
    End If
  Next i
  [A2].Resize(n, 5) = T
End Sub


code VBA du 2ème fichier :

VB: 
Option Explicit

Private Function Ind(chn$) As Byte
  Dim c As String * 1
  c = Left$(chn, 1): Ind = 4 - (c = "C") - 2 * (c = "S") - 3 * (c = "V")
End Function

Sub Essai()
  If ActiveSheet.Name <> "ExportDetailsRetailes_2021-04-0" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim T, chn$, z As Byte, t1, t2, m As Byte, v#, s#, i&, j As Byte
  n = n - 1: T = [A2].Resize(n, 7): Application.ScreenUpdating = 0
  i = Cells(Rows.Count, 3).End(3).Row: If i > 1 Then Range("C2:G" & i).ClearContents
  For i = 1 To n
    chn = T(i, 1)
    If chn <> "" Then
      z = -(InStr(chn, vbLf) > 0)
      If z = 0 Then
        v = T(i, 2): If v > 0 Then T(i, 3) = v: T(i, Ind(chn)) = v
      Else
        t1 = Split(chn, vbLf): t2 = Split(T(i, 2), vbLf): m = UBound(t1): s = 0
        For j = 0 To m
          v = t2(j): If v > 0 Then chn = t1(j): T(i, Ind(chn)) = v: s = s + v
        Next j
        If s > 0 Then T(i, 3) = s
      End If
    End If
  Next i
  [A2].Resize(n, 7) = T
End Sub


attention : bien qu'ils se ressemblent beaucoup,
les 2 codes VBA ci-dessus sont différents !

soan
 

Pièces jointes

  • Panier moyen test v2.xlsm
    216.3 KB · Affichages: 2
  • panier moyen 2ème v2.xlsm
    459.8 KB · Affichages: 2
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir elodie.fc33, soan,

Si le but est de calculer les CA TOTAL c'est très simple avec cette fonction VBA :
VB: 
Function Total(x$)
Dim s, i%
x = Replace(x, ",", ".")
s = Split(x, vbLf)
For i = 0 To UBound(s)
    Total = Total + Val(s(i))
Next
End Function
A+
 

Pièces jointes

  • panier moyen 2eme(1) .xlsm
    296.7 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Si l'on veut ventiler les CA TTC par CATEGORIES placer cette macro dans le code de la feuille "Ventilation" :
VB: 
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, y$, s1, s2, ub%, j%, z$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Feuil2.[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    y = Replace(tablo(i, 2), ",", ".")
    s1 = Split(x, vbLf)
    s2 = Split(y, vbLf)
    ub = UBound(s1)
    If UBound(s2) < ub Then y = y & String(ub - UBound(s2), vbLf): s2 = Split(y, vbLf)
    For j = 0 To ub
        z = Trim(s1(j))
        If z <> "" Then d(z) = d(z) + Val(s2(j)) 'somme des CA TTC
Next j, i
'---restitution---
With [A2] '1ère cellule de destination, à adapter
    If d.Count Then
        .Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
        .Offset(, 1).Resize(d.Count) = Application.Transpose(d.items)
    End If
    .Offset(d.Count).Resize(Rows.Count - d.Count - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub
Elle se déclenche quand on active la feuille, fichier (2).
 

Pièces jointes

  • panier moyen 2eme(2).xlsm
    305 KB · Affichages: 4
Vote positif 0 Vote négatif

Discussions similaires

Lulu974
  • Résolu(e)
Microsoft 365 Excel Somme plusieurs critères d'une même cellule à 2 conditions
Réponses
8
Affichages
2 K
AtTheOne
AtTheOne
S
  • Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
7 K
Scorp0211
S
P
  • Résolu(e)
XL 2019 Affectation d'une cellule vide la valeur de 1
Réponses
2
Affichages
2 K
Praveena
P
D
  • Question
XL pour MAC Retraitement (trop complexe pour moi) d'une base de données
3 4 5
Réponses
74
Affichages
10 K
didcac
D
I
  • Question
additionner les nombres d une meme cellule
Réponses
12
Affichages
8 K
Staple1600
Staple1600
E
  • Question
Comment multiplier les chiffres d'une colonne par une seule cellule?
Réponses
4
Affichages
15 K
Evrard
E
corvelc
  • Question
Par macro récuperer la somme des valeurs d'une même cellule sur plusieurs onglets
Réponses
4
Affichages
5 K
corvelc
corvelc
P
  • Question
Calcul de la moyenne en fonction de la valeur d'une cellule
Réponses
2
Affichages
1 K
phenix873
P
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
G
  • Question
recherche une macro pour comparer les nombres de deux tableaux
Réponses
3
Affichages
4 K
Squirel
S

Membres actuellement en ligne

18 membres et 351 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 698
Messages
2 112 023
Membres
111 404
dernier inscrit
adnen om