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

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

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

Jacky67

XLDnaute Barbatruc

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
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: 16
Dernière édition:

elodie.fc33

XLDnaute Nouveau
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
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

R@chid

XLDnaute Barbatruc
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
 

elodie.fc33

XLDnaute Nouveau
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
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

elodie.fc33

XLDnaute Nouveau
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
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
 

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:

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

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
 

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

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

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

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

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 904
Membres
101 834
dernier inscrit
Jeremy06510