Soustraction cellule

[goldenboy]

Bonjour à tous,

Je souhaite comparer deux cellules et en gros effectuer plusieurs soustractions.

La solution serait éventuellement de passer par VBA, peut-être avec une comparaison de chaine de caractères, mais moi je vous avoue que je patauge...

Ci joint un fichier pour plus d'explication.

Je vous remercie d'avance et vous souhaite par cette occasion une très belle année 2014.

Cordialement.

 

[Paf]

Re : Soustraction cellule

bonjour,

quelques questions :

les données sont elles toujours en A3 et B3?
les données de A3 et B3 à soustraire sont ellles toujours en vis à vis ?
les données sont elles forcément groupées dans une cellule, peut on envisager une donnée une cellule ?

A+

 

[goldenboy]

Re : Soustraction cellule

Bonjour Paf,

Les données ne sont pas forcement en A3 et en B3.
Elle ne sont pas forcement en vis à vis.
Elles sont bien dans une seule cellule, mais l'une en dessous de l'autre.

Il peut par exemple y avoir en A3 :
"SIH STU :
9 du 30/12/2013
13 du 31/12/2013
2 du 02/01/2014"

Et en B3 :
"SIH 940 :
1 du 27/12/2013
10 du 30/12/2013
17 du 31/12/2013
2 du 02/01/2014"

Ce qui aurait pour résultat :
"SIH 940 :
1 du 27/12/2013
1 du 30/12/2013
4 du 31/12/2013"

Je sais que quand on clic dans la cellule pour selectionner le texte et le copier, lorsque que l'on colle les données, chaque ligne est inscrite dans une cellule différente. Mais je n'ai pas réussi à faire cette opération via VBA.
L'enregistreur propose un "forulaR1C1" et place tout seul les sauts de ligne chr(10).

 

[Hervé]

Re : Soustraction cellule

salut à vous deux

un premier jet pour voir si le principe est bon

Private Sub CommandButton1_Click()
Dim tablo
Dim tablo1()
Dim tablo2()
Dim i As Byte
Dim j As Byte
Dim x As Byte
Dim t As String
Dim present As Boolean

tablo = Split(Range("a3"), Chr(10))
For i = 1 To UBound(tablo)
    x = x + 1
    ReDim Preserve tablo1(1 To 2, 1 To x)
    tablo1(1, x) = Split(tablo(i), "du")(0)
    tablo1(2, x) = Split(tablo(i), "du")(1)
Next i
x = 0

tablo = Split(Range("b3"), Chr(10))
For i = 1 To UBound(tablo)
    x = x + 1
    ReDim Preserve tablo2(1 To 2, 1 To x)
    tablo2(1, x) = Split(tablo(i), "du")(0)
    tablo2(2, x) = Split(tablo(i), "du")(1)
Next i

For i = LBound(tablo1, 2) To UBound(tablo1, 2)
    For j = LBound(tablo2, 2) To UBound(tablo2, 2)
        If tablo1(2, i) = tablo2(2, j) Then
            present = True
            tablo2(1, j) = tablo2(1, j) - tablo1(1, i)
        End If
    Next j
    If present = False Then
        present = True
        ReDim Preserve tablo2(1 To 2, 1 To UBound(tablo2, 2) + 1)
        tablo2(1, UBound(tablo2, 2)) = tablo(1, i)
        tablo2(2, UBound(tablo2, 2)) = tablo(2, i)
    End If
Next i

t = tablo(0) & Chr(10)

For i = LBound(tablo2, 2) To UBound(tablo2, 2)
    If tablo2(1, i) <> 0 Then
        t = t & tablo2(1, i) & " du " & tablo2(2, i) & Chr(10)
    End If
Next i
Range("c3") = t

End Sub

a plus

 

[Hervé]

Re : Soustraction cellule

re

correction d'un bug :

Private Sub CommandButton1_Click()
Dim tablo
Dim tablo1()
Dim tablo2()
Dim i As Byte
Dim j As Byte
Dim x As Byte
Dim t As String
Dim present As Boolean

tablo = Split(Range("a4"), Chr(10))
For i = 1 To UBound(tablo)
    x = x + 1
    ReDim Preserve tablo1(1 To 2, 1 To x)
    tablo1(1, x) = Split(tablo(i), "du")(0)
    tablo1(2, x) = Split(tablo(i), "du")(1)
Next i
x = 0

tablo = Split(Range("b4"), Chr(10))
For i = 1 To UBound(tablo)
    x = x + 1
    ReDim Preserve tablo2(1 To 2, 1 To x)
    tablo2(1, x) = Split(tablo(i), "du")(0)
    tablo2(2, x) = Split(tablo(i), "du")(1)
Next i

For i = LBound(tablo1, 2) To UBound(tablo1, 2)
    For j = LBound(tablo2, 2) To UBound(tablo2, 2)
        If tablo1(2, i) = tablo2(2, j) Then
            present = True
            tablo2(1, j) = tablo2(1, j) - tablo1(1, i)
        End If
    Next j
    If present = False Then
        present = True
        ReDim Preserve tablo2(1 To 2, 1 To UBound(tablo2, 2) + 1)
        tablo2(1, UBound(tablo2, 2)) = tablo1(1, i)
        tablo2(2, UBound(tablo2, 2)) = tablo1(2, i)
    End If
Next i

t = tablo(0) & Chr(10)

For i = LBound(tablo2, 2) To UBound(tablo2, 2)
    If tablo2(1, i) <> 0 Then
        t = t & tablo2(1, i) & " du " & tablo2(2, i) & Chr(10)
    End If
Next i
Range("c3") = t

End Sub

 

[goldenboy]

Re : Soustraction cellule

Bonjour Hervé.

Je n'ai pas bien compris la correction apportée, mais sinon, la premiere ou la deuxième macro ont l'air de fonctionner.

Il faut simplement pas de ligne vide dans la cellulle ni à la fin.

Est ce qu'il est possible d'avoir qu'un seul espace entre le chiffre et le mot "du" et le mot "du" et la date?

J'ai essayé de bidouiller mais j'ai pas réussi.

 

[Hervé]

Re : Soustraction cellule

re

la modification est infime mais la première version ne gérait pas le fait d'avoir une date en A non renseigné en B

le code à modifier pour les espaces :

        t = t & Trim(tablo2(1, i)) & " du " & Trim(tablo2(2, i)) & Chr(10)

test bien ce code, je ne serai pas surpris qu'il subsiste des bug, ta demande n'est pas simple et le code en découlant ne l'est pas non plus

a plus

 

[goldenboy]

Re : Soustraction cellule

Bien vu pour le Trim.

Je vais tester sur plusieurs jours avant de le mettre dans mon code global, mais à priori ça fonctionne bien.

Dans tous les cas :
- Les dates en A seront en B
- Les quantités en A seront toujours inferieur à B

En faite B comporte B et A. c'est pour ça que je veux soustraire A.
C'est comme si A était la pate et B la quiche.
La quiche contient toujours la pate et moi j'en extrait le reste des aliments.

Je vous remercie de votre aide et vous tiens informés si je rencontre des difficultés.

Cordialement.

 

[goldenboy]

Re : Soustraction cellule

Bonsoir Hervé.

J'utilise ce code tous les matins et il fonctionne sans problème.

Merci beaucoup.

Très cordialement.