Menu

Soustraire cellules une à une, enfin presque :) [Résolu]

Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 4 mars 2018 à 22:23 - Dernière réponse : Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention
- 8 mars 2018 à 19:37
Bien le bonjour !
Mon niveau Excel est très basique et malgré mes recherches, je ne trouve rien qui m'aide à avancer. Il est possible que malgré mes efforts, certaines terminologies ne soient pas les bonnes, je suis nul sur cet outil.

J'ai plusieurs classeurs qui ont plusieurs feuilles. Tous les classeurs ont une même structure strictement identique. Les feuilles (dans l'ordre) sont aussi strictement identiques entre les classeurs. Dans ces feuilles, des nombres positifs sur plusieurs lignes et colonnes.
J'aimerais faire un énième classeur (même structure que les premiers) dans lequel je pourrai faire apparaître la "différence" (numérique) entre chaque cellule d'un même emplacement dans 2 classeurs différents. Une "super soustraction multi cellules et inter classeurs" où je pourrais choisir les classeurs à "comparer" et afficher le delta entre les valeurs de toutes les cellules en "plus" ou "moins".

Voilà, j'espère que le pavé sera compréhensible ou du moins, qu'il ne rebutera personne :)

Merci d'avance
Afficher la suite 

Votre réponse

19 réponses

yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention - 4 mars 2018 à 23:25
0
Merci
bonsoir, cela t'avancera peut-être de faire ainsi:
enregistre en A1 de ton nouveau classeur la formule suivante, adaptée à tes classeurs et feuilles:
='C:\Users\toi\Documents\chemin\[fichier1.xls]f1'!A1-C:\Users\toi\Documents\chemin\[fichier2.xls]f1'!A1 
duplique la formule vers le bas et vers la droite
Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 4 mars 2018 à 23:59
MERCI
Commenter la réponse de yg_be
Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 4 mars 2018 à 23:59
0
Merci
Là, je suis scotché !
Trop fort !! C'est exactement ce que je voulais. J'en reviens pas. Je pensais pas être clair (c'est peut être pas le cas) mais tu m'as compris ! Génial !
Plus qu'à remplacer à souhait les fichiers pointés par une liste déroulante. Je devrais y arriver et ça me fera un outil hyper pratique.
MERCI
Commenter la réponse de Zerome33
Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 5 mars 2018 à 22:08
0
Merci
Re,
Ça fonctionne nickel mais je rencontre des difficultés à jongler avec les fichiers pointés.
J'ai pas mal de classeurs et un seul pour afficher les résultats.
J'aimerais pouvoir sélectionner indépendamment les fichiers 1 et 2 (suivant la formule au dessus) à partir d'une liste et que la formule "s'adapte" en lisant les fichiers choisis.
Est ce possible ?
yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention - 6 mars 2018 à 00:10
moi j'utiliserais ce code (partiellement testé), à mettre et à exécuter dans le fichier recap:
Option Explicit
Sub selfic()
Dim strFileToOpen1 As String, strFileToOpen2 As String
Dim sh As Worksheet
Dim cel As Range
Dim nfeuil As String, caddr As String, form As String
Dim p1 As String, n1 As String, p2 As String, n2 As String
Dim pos1 As Integer, pos2 As Integer

strFileToOpen1 = Application.GetOpenFilename _
(Title:="Premier classeur", _
FileFilter:="Excel Files *.xls* (*.xls*),")
strFileToOpen2 = Application.GetOpenFilename _
(Title:="Second classeur", _
FileFilter:="Excel Files *.xls* (*.xls*),")
pos1 = InStrRev(strFileToOpen1, "\")
p1 = Left(strFileToOpen1, pos1 - 1)
n1 = Right(strFileToOpen1, Len(strFileToOpen1) - pos1)
pos2 = InStrRev(strFileToOpen1, "\")
p2 = Left(strFileToOpen2, pos2 - 1)
n2 = Right(strFileToOpen2, Len(strFileToOpen2) - pos2)
For Each sh In ThisWorkbook.Worksheets
    nfeuil = sh.Name
    For Each cel In sh.Cells
    caddr = cel.Address
    form = "='" & p1 & "\[" & n1 & "]" & nfeuil & "'!" & caddr & "-'" & p2 & "\[" & n2 & "]" & nfeuil & "'!" & caddr
    cel.Formula = form
    Next cel
Next sh
End Sub
yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention > yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention - 6 mars 2018 à 08:04
petites améliorations:
Option Explicit
Sub selfic()
Dim strFileToOpen1 As String, strFileToOpen2 As String
Dim sh As Worksheet
Dim cel As Range
Dim nfeuil As String, caddr As String, form As String
Dim p1 As String, n1 As String, p2 As String, n2 As String
Dim pos1 As Integer, pos2 As Integer
Dim str1 As String, str2 As String

strFileToOpen1 = Application.GetOpenFilename _
(Title:="Premier classeur", _
FileFilter:="Excel Files *.xls* (*.xls*),")
strFileToOpen2 = Application.GetOpenFilename _
(Title:="Second classeur", _
FileFilter:="Excel Files *.xls* (*.xls*),")
pos1 = InStrRev(strFileToOpen1, "\")
p1 = Left(strFileToOpen1, pos1 - 1)
n1 = Right(strFileToOpen1, Len(strFileToOpen1) - pos1)
pos2 = InStrRev(strFileToOpen1, "\")
p2 = Left(strFileToOpen2, pos2 - 1)
n2 = Right(strFileToOpen2, Len(strFileToOpen2) - pos2)
For Each sh In ThisWorkbook.Worksheets
    nfeuil = sh.Name
    str1 = "='" & p1 & "\[" & n1 & "]" & nfeuil & "'!"
    str2 = "-'" & p2 & "\[" & n2 & "]" & nfeuil & "'!"
    For Each cel In sh.Cells
        caddr = cel.Address
        form = str1 & caddr & str2 & caddr
        cel.Formula = form
    Next cel
Next sh
End Sub
Commenter la réponse de Zerome33
Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 6 mars 2018 à 17:54
0
Merci
Merci pour ton aide.

Mon ordi peine avec ça, il lui faut environ 15min pour pondre une ligne... c'est pas possible !
Est ce qu'il travaille sur toutes les cellules des feuilles ?
Si oui, comment spécifier une zone pour réduire le travail ? Un autre moyen d'alléger le truc ?

En fait, la formule (avec les chemins de fichiers) va très bien puisque je sélectionne les valeurs source à l'ouverture. Seulement j'aimerais afficher les sources choisies dans chacune des feuilles du Récap pour rappel.. C'est possible ?
Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention > yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention - 7 mars 2018 à 16:11
Effectivement, les sources ne changeront pas dans mon cas. A part 3-4 sources succeptibles de contenir du calcul sur 2 feuilles, toutes les autres sont des extractions "brutes" sans aucun lien. Par contre, de nouveaux classeurs sources (structure identique) pourront venir s'ajouter à la liste.

Je reformule ma dernière demande :
Comparer les valeurs de A4:A8 (par ex) de chaque feuille des 2 classeurs source.
Résultat dans les mêmes cellules dans classeur "Recap".
Si identique, résultat = valeur source
Si différent, résultat = cel vide + couleur

Te casses pas la tête. Ce que j'utilise fait le job (grâce à toi). Là je cherche confort de rigueur avec ce dernier point...
yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention > Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 7 mars 2018 à 16:55
sans doute ceci:
Option Explicit
Sub selfic()
Dim strFileToOpen1 As String, strFileToOpen2 As String
Dim sh As Worksheet
Dim cel As Range
Dim nfeuil As String
Dim savedcalcmode As XlCalculation
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim nrow As Long, ncol As Long
Dim cel1 As Range, cel2 As Range

strFileToOpen1 = Application.GetOpenFilename _
(Title:="Premier classeur", _
FileFilter:="Excel Files *.xls* (*.xls*),")
strFileToOpen2 = Application.GetOpenFilename _
(Title:="Second classeur", _
FileFilter:="Excel Files *.xls* (*.xls*),")
Set wb1 = Workbooks.Open(strFileToOpen1)
Set wb2 = Workbooks.Open(strFileToOpen2)
For Each sh In ThisWorkbook.Worksheets
    savedcalcmode = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    nfeuil = sh.Name
    Set sh1 = wb1.Sheets(nfeuil)
    Set sh2 = wb2.Sheets(nfeuil)
    For Each cel In sh.[B2:U33]
        nrow = cel.Row
        ncol = cel.Column
        Set cel1 = sh1.Cells(nrow, ncol)
        Set cel2 = sh2.Cells(nrow, ncol)
        cel = cel1.Value - cel2.Value
    Next cel
    sh.[A1] = strFileToOpen1
    sh.[B1] = strFileToOpen2
    For Each cel In sh.[A4:A8]
        nrow = cel.Row
        ncol = cel.Column
        Set cel1 = sh1.Cells(nrow, ncol)
        Set cel2 = sh2.Cells(nrow, ncol)
        If cel1 = cel2 Then
            cel = cel1
        Else
            cel = ""
            cel.Interior.ColorIndex = 5 ' 5 indicates Blue Color
        End If
    Next cel
    Application.Calculation = savedcalcmode
    Application.ScreenUpdating = True
Next sh
wb1.Close
wb2.Close
End Sub
Zerome33 > yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention - 7 mars 2018 à 20:17
J'ai testé et ça marche ! Tellement bien que y'a beaucoup de bleu... En fait, je me suis aperçu que mes 2 premiers fichiers ne sont pas totalement identiques....
Les cellules comparées correspondent à des points d'échelle "empilés" dans une colonne. Dans un des fichiers source, y'a des points (donc des lignes) en moins, d'autres en plus. Et donc l'empilage se décale, les données aussi... Et c'est du grand n'importe quoi.
Tout n'est pas perdu car je pense que les différences de points d'échelle sont communes entre certaines sources. Plus qu'à faire le tri...
Encore une fois, heureusement que tu étais là sinon je partais vers de grosses incompréhensions et des problèmes...
MERCI
yg_be 5795 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 20 juin 2018 Dernière intervention > Zerome33 - 7 mars 2018 à 20:53
probablement utile d'ajouter
cel.Interior.ColorIndex = 2 'couleur 2: blanc
avant la ligne
Else
, pour éviter que le bleu ne persiste d'une sélection de fichiers à la suivante.
Zerome33 11 Messages postés dimanche 4 mars 2018Date d'inscription 8 mars 2018 Dernière intervention - 8 mars 2018 à 19:37
Merci pour le suivi.
Il faut que je utilise plus le fichier pour voir si d'autres modifs sont nécessaires.
Ce sera l'occasion pour moi de me pencher un peu sur vba avec une certaine motivation.
Je n'hésiterai pas à revenir toquer ici si besoin.
Merci encore.
Commenter la réponse de Zerome33