XL 2013 Extraire des Montants positifs et leurs inverse

G

golby

XLDnaute Nouveau
Bonjour

Je dispose d'un fichier sur excel (export de +10 000 lignes) contenant des montants positifs et leurs contraires.
Par exemple: Dans les lignes 8 ( -50 812 630 187)et 9 ( -50 812 630 187) comportent un même montant mais de signe contraire.
Et aussi la différence entre ces montants est égale à zéro.

Je souhaiterais extraire de ce fichier tous les montants de signe contraire et dont la différence est égale à zéro.
Comment procéder ?
Ci-joint le fichier TEST CHARGE.
 

Pièces jointes

  • TEST CHARGE.xlsx
    10.8 KB · Affichages: 10
Solution
S
@golby

tu m'as donné cette info en MP :

« En fait dans le fichier global certains montants ne se suivent pas. »

dans ce cas, mon 1er code VBA n'est plus valable, car il regardait uniquement 2 lignes qui se suivent ! ce qui était toujours le cas dans ton fichier exemple initial ; maint'nant, j'ai fait une autre version qui utilise la méthode des tableaux (c'est beaucoup plus rapide, même sur plusieurs milliers de lignes, alors si tu as par exemple un fichier de 800 000 lignes, ça ira très bien sauf que tu n'auras plus le temps de faire une pause pour aller prendre un café ! 😜) ; de plus, ma nouvelle version est plus souple car ça marche même pour 2 lignes de montants identiques...​
Trier par date Trier par votes
S

soan

XLDnaute Barbatruc
Inactif
Bonjour golby,

bienvenue sur le site XLD ! :)

j'ai mis une MFC (Mise en Forme Conditionnelle) pour colorier en jaune toute ligne
dont celle qui suit est de montant contraire ; ça donne ceci :​

Image.jpg


peut-être que ça te suffira de les détecter, et qu'il n'y aura pas besoin
de faire un copier/coller dans un nouvel onglet ? 🍀

soan
 

Pièces jointes

  • TEST CHARGE.xlsx
    11.2 KB · Affichages: 4
Vote positif 0 Vote négatif
G

golby

XLDnaute Nouveau
soan à dit:
Bonjour golby,

bienvenue sur le site XLD ! :)

j'ai mis une MFC (Mise en Forme Conditionnelle) pour colorier en jaune toute ligne
dont celle qui suit est de montant contraire ; ça donne ceci :​

Regarde la pièce jointe 1144781

peut-être que ça te suffira de les détecter, et qu'il n'y aura pas besoin
de faire un copier/coller dans un nouvel onglet ? 🍀

soan
Cliquez pour agrandir...
Merci pour la proposition§
Sauf que je veux les copier-coller (montant positif et Inverse) sur un nouvel onglet.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
soan à dit:
j'ai remarqué les deux signes négatifs, moi aussi ; le 2ème montant est sans doute un copier / coller du 1er montant, et @golby a tout simplement oublié d'enlever le signe moins ; dans le fichier, c'est ok : voir les cellules F8 et F9 sur l'image de mon post #4.
Cliquez pour agrandir...
Je ne peux pas actuellement ouvrir le fichier, mais je suis bien sûr tout-à-fait d'accord avec toi pour les deux signes moins et le copier/coller. 👍

Et ce que je voulais aussi, et surtout, dire c'est que la différence entre deux nombres identiques mais de signes contraires ne saurait être égale à zéro !
C'est la somme qui est égale à la tête à Toto... 😉
 
Dernière édition:
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
@golby

voici une autre version du fichier. :)

* sur la 2ème feuille, y'a que les en-têtes de colonnes.

* va sur la 1ère feuille ; fais Ctrl e ➯ travail effectué.

attention : ma solution fonctionne uniquement si les 2 lignes
de montant contraire se suivent l'une sous l'autre !

si ça n'est PAS TOUJOURS LE CAS, il faudrait un autre code VBA !


code VBA de Module1 (23 lignes) :

VB: 
Option Explicit

Sub CpyLigs()
  If ActiveSheet.Name <> "Charges" Then Exit Sub
  Dim m&, n&: m = Rows.Count
  n = Cells(m, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim cel As Range, i&, j&, k&: Application.ScreenUpdating = 0
  With Worksheets("Lignes soldées")
    j = .Cells(m, 1).End(3).Row
    If j > 1 Then .Range("A2:F" & j).ClearContents
    j = 2
    For i = 2 To n
      k = i + 1
      If Cells(i, 6) = -Cells(k, 6) Then
        Cells(i, 1).Resize(2, 6).Copy
        .Cells(j, 1).PasteSpecial -4163
        i = i + 1: j = j + 2
      End If
    Next i
    Application.CutCopyMode = 0: .Select: [A1].Select
  End With
End Sub

soan
 

Pièces jointes

  • TEST CHARGE.xlsm
    21 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
@golby

tu m'as donné cette info en MP :

« En fait dans le fichier global certains montants ne se suivent pas. »

dans ce cas, mon 1er code VBA n'est plus valable, car il regardait uniquement 2 lignes qui se suivent ! ce qui était toujours le cas dans ton fichier exemple initial ; maint'nant, j'ai fait une autre version qui utilise la méthode des tableaux (c'est beaucoup plus rapide, même sur plusieurs milliers de lignes, alors si tu as par exemple un fichier de 800 000 lignes, ça ira très bien sauf que tu n'auras plus le temps de faire une pause pour aller prendre un café ! 😜) ; de plus, ma nouvelle version est plus souple car ça marche même pour 2 lignes de montants identiques qui ne se suivent pas. :)

la méthode d'utilisation est identique, mais comme les données sont les mêmes, tu ne verras pas de différence tangible ! tu verras une différence nettement sensible uniquement sur tes vrais fichiers volumineux, et c'est là seulement que tu pourras juger réellement de l'efficacité de la nouvelle méthode.​


code VBA de Module1 (32 lignes) :

VB: 
Option Explicit: Option Base 1

Sub CpyLigs()
  If ActiveSheet.Name <> "Charges" Then Exit Sub
  Dim m&, n&: m = Rows.Count
  n = Cells(m, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim cel As Range, T1, T2, i&, j&, k&, c&
  With Worksheets("Lignes soldées")
    k = .Cells(m, 1).End(3).Row: Application.ScreenUpdating = 0
    If k > 1 Then .Range("A2:F" & k).ClearContents
    n = n - 1: T1 = [A2].Resize(n, 7): ReDim T2(n, 6): k = 1
    For i = 1 To n
      If T1(i, 7) = 0 Then
        For j = i + 1 To n
          If T1(j, 7) = 0 Then
            If T1(i, 6) = -T1(j, 6) Then
              For c = 1 To 6: T2(k, c) = T1(i, c): Next c
              T1(i, 7) = 1: k = k + 1
              For c = 1 To 6: T2(k, c) = T1(j, c): Next c
              T1(j, 7) = 1: k = k + 1
              Exit For
            End If
          End If
        Next j
      End If
    Next i
    .Select
    [A2].Resize(k - 1, 6) = Application.Index(T2, _
      Evaluate("Row(" & "1:" & n & ")"), [Column(A:F)])
  End With
End Sub

soan
 

Pièces jointes

  • TEST CHARGE.xlsm
    22 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif
Solution
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

golby à dit:
Je souhaiterais extraire de ce fichier tous les montants de signe contraire et dont la différence est égale à zéro.
Comment procéder ?
Cliquez pour agrandir...
Est-ce que ça veut dire qu'il faut extraire tous les doublons en valeur absolue ?

En attendant une réponse, voici, en pièce jointe, une proposition.
 

Pièces jointes

  • TEST-CHARGE_(TooFatBoy-v1).xlsm
    20.6 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
G

golby

XLDnaute Nouveau
soan à dit:
@golby

tu m'as donné cette info en MP :

« En fait dans le fichier global certains montants ne se suivent pas. »

dans ce cas, mon 1er code VBA n'est plus valable, car il regardait uniquement 2 lignes qui se suivent ! ce qui était toujours le cas dans ton fichier exemple initial ; maint'nant, j'ai fait une autre version qui utilise la méthode des tableaux (c'est beaucoup plus rapide, même sur plusieurs milliers de lignes, alors si tu as par exemple un fichier de 800 000 lignes, ça ira très bien sauf que tu n'auras plus le temps de faire une pause pour aller prendre un café ! 😜) ; de plus, ma nouvelle version est plus souple car ça marche même pour 2 lignes de montants identiques qui ne se suivent pas. :)

la méthode d'utilisation est identique, mais comme les données sont les mêmes, tu ne verras pas de différence tangible ! tu verras une différence nettement sensible uniquement sur tes vrais fichiers volumineux, et c'est là seulement que tu pourras juger réellement de l'efficacité de la nouvelle méthode.​


code VBA de Module1 (32 lignes) :

VB: 
Option Explicit: Option Base 1

Sub CpyLigs()
  If ActiveSheet.Name <> "Charges" Then Exit Sub
  Dim m&, n&: m = Rows.Count
  n = Cells(m, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim cel As Range, T1, T2, i&, j&, k&, c&
  With Worksheets("Lignes soldées")
    k = .Cells(m, 1).End(3).Row: Application.ScreenUpdating = 0
    If k > 1 Then .Range("A2:F" & k).ClearContents
    n = n - 1: T1 = [A2].Resize(n, 7): ReDim T2(n, 6): k = 1
    For i = 1 To n
      If T1(i, 7) = 0 Then
        For j = i + 1 To n
          If T1(j, 7) = 0 Then
            If T1(i, 6) = -T1(j, 6) Then
              For c = 1 To 6: T2(k, c) = T1(i, c): Next c
              T1(i, 7) = 1: k = k + 1
              For c = 1 To 6: T2(k, c) = T1(j, c): Next c
              T1(j, 7) = 1: k = k + 1
              Exit For
            End If
          End If
        Next j
      End If
    Next i
    .Select
    [A2].Resize(k - 1, 6) = Application.Index(T2, _
      Evaluate("Row(" & "1:" & n & ")"), [Column(A:F)])
  End With
End Sub

soan
Cliquez pour agrandir...
Bonjour Soan!
J'aimerai dire merci, car ce fichier répond parfaitement à mes attentes!
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
Microsoft 365 Comment Additionner des valeurs d'une colonnes basées sur leurs dates dans une autre colonne
Réponses
5
Affichages
888
desto
D
B
  • Question
SommeProd et MFC sur critères Dates et montants : 1 lot de 3 sujets
Réponses
2
Affichages
1 K
Batiscaf
B
J
  • Question
Formule Excel sommer avec critères pas sur les mêmes lignes
Réponses
4
Affichages
706
julien91080
J
R
  • Question
Somme des négatifs et des positifs
2
Réponses
21
Affichages
21 K
Distinxion
D
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
5
Affichages
59 K
Best1
B
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
46 K
MichelXld
M

Membres actuellement en ligne

3 membres et 65 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
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa