Chercher cellule identique ds un autre colonne

bon, j'ai résolu mon probleme en l'écrivant...  
donc si qqn a juste une idée pour le rendre moins long et répétitif ?

code final :

Dim ws_source As Worksheet

Dim matched As Range

Dim cells_found As Range

Dim unmatched As Range

Dim i As Integer 

Dim ligne As Long

Dim switch As Boolean

Dim vide As Boolean

dim first_row as long

dim last_row as long

 
Set ws_source = Worksheets("Mastersheet")

Set matched = Worksheets("Matched").Rows(2)

Set unmatched = Worksheets("Other").Rows(2)

 
ws_source.Range("D:D").Delete 'delete merged cells

ws_source.Range("H:H").Delete

 
first_row = ws_source.Range("B1:B65536").End(xlDown).Row ' find first and last row of the table

last_row = ws_source.Range("B" & first_row & ":B65536").End(xlDown).Row

 
MsgBox "" & first_row & vbCr & _

        "" & last_row

 
With ws_source.Rows(first_row)

    .Copy Worksheets("Matched").Rows(1)

    .Copy Worksheets("Other").Rows(1)

End With

 
For i = first_row + 1 To last_row

    'execute le code pour les cellules non vide et au format numerique de la colonne debit

    Select Case ws_source.Cells(i, 8).Value

        Case Is = "": vide = True

        Case Else: vide = False

    End Select

 
    If vide = False Then

        Select Case ws_source.Cells(i, 7).Value ' on regarde la valeur de credit

            Case "": switch = True ' cellule credit vide, cas 1

            Case Is = Abs(ws_source.Cells(i, 8).Value): 'meme montant en debit dc copie la ligne

                switch = False: ws_source.Rows(i).Copy matched

                Set matched = matched.Offset(1)

                ws_source.Rows(i).Hidden = True

 
            Case Else: 'montants différents ds Debit et Credit sur la meme ligne

                switch = False

                ws_source.Rows(i).Copy unmatched

                Set unmatched = unmatched.Offset(1)

                ws_source.Rows(i).Hidden = True

 
        End Select

        'cas 1, on cherche la valeur absolue de la cellule Debit dans toutes les cellules de la colonne credit

        If switch = True Then

            Set cells_found = Range("G" & first_row + 1 & ":G" & last_row).Find(Abs(ws_source.Cells(i, 8).Value), lookat:=xlWhole)

            If Not cells_found Is Nothing Then ' meme montant trouvé

                ligne = cells_found.Row

                ws_source.Rows(ligne).Copy matched

                ws_source.Rows(ligne).Hidden = True

                Set matched = matched.Offset(1)

                ws_source.Rows(i).Copy matched

                ws_source.Rows(i).Hidden = True

                Set matched = matched.Offset(1)

            Else:

                ws_source.Rows(ligne).Copy unmatched  'copy unmatched

                ws_source.Rows(ligne).Hidden = True

                Set unmatched = unmatched.Offset(1)

                ws_source.Rows(i).Copy unmatched

                ws_source.Rows(i).Hidden = True

                Set unmatched = unmatched.Offset(1)

            End If

        End If

    ElseIf vide = True Then

        'on cherche la valeur absolue de la cellule credit dans toutes les cellules de la colonne debit

        Set cells_found = Range("H" & first_row & ":H" & last_row).Find((ws_source.Cells(i, 7).Value * -1), lookat:=xlWhole)

        If Not cells_found Is Nothing Then ' meme montant trouvé dc copie ds matched

            ligne = cells_found.Row

            ws_source.Rows(ligne).Copy matched

            ws_source.Rows(ligne).Hidden = True

            Set matched = matched.Offset(1)

            ws_source.Rows(i).Copy matched

            ws_source.Rows(i).Hidden = True

            Set matched = matched.Offset(1)

        Else:

             'pas trouvé dc copie ligne ds unmatched

            ws_source.Rows(i).Copy unmatched

            ws_source.Rows(i).Hidden = True

            Set unmatched = unmatched.Offset(1)

        End If

    End If

Next

ws_source.Rows.Hidden = False

Eh, eh, le temps que je regarde et tu as posté la réponse. A la décharge, je te faisais une réponse longue. La voici (c'est la réponse au premier code) :

Dim ws_source As Worksheet
Dim matched As Range
Dim cells_found As Range
Dim unmatched As Range
Dim i As Integer
Dim ligne As Long
Dim switch As Boolean
Dim vide As Boolean
 
Set ws_source = Worksheets("Mastersheet" )
Set matched = Worksheets("Matched" ).Rows(2)
Set unmatched = Worksheets("other" ).Rows(2)

' // Bien

ws_source.Range("D:D" ).Delete 'delete merged cells
ws_source.Range("H:H" ).Delete

' // Pas mal. Tu peux aussi utiliser Columns("D") ou Columns(4)

first_row = ws_source.Range("B1:B65536" ).End(xlDown).Row ' find first and last row of the table
last_row = ws_source.Range("B" & first_row & ":B65536" ).End(xlDown).Row

  Tu te donnes bien du mal !
Et tes variables ne sont pas déclarées  

' // Avec des nombres
first_row = Feuil1.Range("B1").End(xlDown).Row
last_row = Feuil1.Cells(first_row, 2).End(xlDown).Row
 
' // Avec des cellules
Set cell_1er = ws_source.Range("B1").End(xlDown)
Set cell_der = cell_1er.End(xlDown)

MsgBox "" & first_row & vbCr & _
        "" & last_row

Oozenot, le débogueur fou !!!  

With ws_source.Rows(first_row)
    .Copy Worksheets("Matched" ).Rows(1)
    .Copy Worksheets("Other" ).Rows(1)
End With
 
For i = first_row + 1 To last_row

Ah très grave erreur ! Les lignes vont jusqu'à 65536, or i est un Integer...

'execute le code pour les cellules non vide et au format numerique de la colonne debit
    Select Case ws_source.Cells(i, 8).Value
        Case Is = "": vide = True
        Case Else: vide = False
    End Select

Un Select ici ???   Tu veux bien me changer ça tout de suite ! Mets un simple If ou mieux :

vide = ws_source.Cells(i, 8).Value = ""

If vide = False Then

Arrête de comparer des booléens. Ce sont déjà des booléens  

If Not vide Then

Select Case ws_source.Cells(i, 7).Value ' on regarde la valeur de credit
            Case "": switch = True ' cellule credit vide, cas 1
            Case Is = Abs(ws_source.Cells(i, 8).Value): 'meme montant en debit dc copie la ligne
                switch = False: ws_source.Rows(i).Copy matched
                Set matched = matched.Offset(1)
                ws_source.Rows(i).Hidden = True

Pas mal   Et le coup de la ligne cachée, c'est astucieux.

Case Else: 'montants différents ds Debit et Credit sur la meme ligne
                switch = False
                ws_source.Rows(i).Copy unmatched
                Set unmatched = unmatched.Offset(1)
                ws_source.Rows(i).Hidden = True
        End Select
        'cas 1, on cherche la valeur absolue de la cellule Debit dans toutes les cellules de la colonne credit
        If switch = True Then

 

Set cells_found = Range("G" & first_row & ":G" & last_row).Find(Abs(ws_source.Cells(i, 8).Value), lookat:=xlWhole)

 

If Not cells_found Is Nothing Then ' meme montant trouvé

Ah, enfin une comparaison bien faite

ligne = cells_found.Row
                ws_source.Rows(ligne).Copy matched
                ws_source.Rows(ligne).Hidden = True
                Set matched = matched.Offset(1)
                ws_source.Rows(i).Copy matched
                ws_source.Rows(i).Hidden = True
            Else:

(Vire les deux points après le Else) Dis donc, t'as pas l'impression d'avoir déjà traité ces cas dans le Select ?

ws_source.Rows(ligne).Copy unmatched  'copy unmatched
                ws_source.Rows(ligne).Hidden = True
                Set unmatched = unmatched.Offset(1)
                ws_source.Rows(i).Copy unmatched
                ws_source.Rows(i).Hidden = True
            End If
        End If
    Else:

(Vire les deux points après le Else)

'on cherche la valeur absolue de la cellule credit dans toutes les cellules de la colonne debit
        Set cells_found = Range("H" & first_row & ":H" & last_row).Find(ws_source.Cells(i, 7).Value * -1, lookat:=xlWhole)
        If Not cells_found Is Nothing Then ' meme montant trouvé dc copie ds matched
            ligne = cells_found.Row
            ws_source.Rows(ligne).Copy matched
            ws_source.Rows(ligne).Hidden = True
            Set matched = matched.Offset(1)
            ws_source.Rows(i).Copy matched
            ws_source.Rows(i).Hidden = True
        Else:

(Vire les deux points après le Else)

ws_source.Rows(ligne).Copy unmatched  'pas trouvé dc copie ligne ds unmatched
            ws_source.Rows(ligne).Hidden = True
            Set unmatched = unmatched.Offset(1)
            ws_source.Rows(i).Copy unmatched
            ws_source.Rows(i).Hidden = True
        End If
    End If
Next
ws_source.Rows.Hidden = False

Bon, ce n'est pas mal tout ça, sinon  

-------------------

D'abord, une procédure pour ne pas faire de répétitions :

Sub LineCopy(ByVal Line As Range, ByRef target As Range, Optional Clear As Boolean)
	Line.EntireRow.Copy Destination:=target
	Set target = target.Offset(1)
	If Clear Then Line.Clear
End Sub

Maintenant le corps de la procédure principale :

Dim ws_source As Worksheet
Dim matched   As Range
Dim unmatched As Range
Dim cell_1er  As Range
Dim cell      As Range
Dim cell_D    As Range
Dim cell_C    As Range
Dim plage     As Range
Dim found     As Boolean
 
Set matched = Worksheets("Matched" ).Rows(1)
Set unmatched = Worksheets("other" ).Rows(1)
 
Set ws_source = Worksheets("Mastersheet" ).Copy(After:=Worksheets(Worksheets.Count))
Set cell_1er = ws_source.Range("B1").End(xlDown)
 
Set plage = ws_source.Range(cell_1er, cell_1er.End(xlDown))
 
LineCopy ws_source.Rows(1), matched
LineCopy ws_source.Rows(1), unmatched
 
For Each cell In plage
 
	Set cell_D = cells.Offset(0, 7)
	Set cell_C = cells.Offset(0, 8)
 
	' // --- A charge pour Oozenot de vérifier le numéro de décalage de colonnes ---
	MsgBox "cellule DEBIT"  & cell_D.Columns.Address(False, False)
	MsgBox "cellule CREDIT" & cell_C.Columns.Address(False, False)
	' // --- A charge pour Oozenot de vérifier le numéro de décalage des colonnes ---
 
	If Trim(cell_D.Value) = "" And _
	   Trim(cell_C.Value) = "" _
	Then
		' // DEBIT et CREDIT sont vides
		' // On ne fait rien.
 
	ElseIf Trim(cell_D.Value) <> "" And _
		   Trim(cell_C.Value) <> "" _
	Then
		' // DEBIT et CREDIT sont non vides
 
		If Abs(cell_D.Value) = Abs(cell_C.Value) Then
			LineCopy cell, matched, True
		Else
    	    LineCopy cell, unmatched, True
    	End If
 
	ElseIf Trim(cell_D) <> "" _
	Then
		' // DEBIT est non vide / CREDIT est donc vide
 
		For Each cell_C in plage.Offset(8)
			If Trim(cell_C) <> "" And _
			   Abs(cell_D.Value) = Abs(cell_C.Value) _
			Then
				LineCopy cell_D, matched, True
				LineCopy cell_C, matched, True    	    	
				found = True
				Exit For
			End If
		Next
		If Not found Then LineCopy cell_D unmatched, True
 
	ElseIf Trim(cell_C) <> "" _
	Then
		' // CREDIT est non vide / DEBIT est donc vide
 
		For Each cell_D in plage.Offset(7)
			If Trim(cell_D) <> "" And _
			   Abs(cell_D.Value) = Abs(cell_C.Value) _
			Then
				LineCopy cell_D, matched, True
				LineCopy cell_C, matched, True
				found = True
    	    	Exit For
			End If
		Next
		If Not found Then LineCopy cell_C, unmatched, True
	End If
Next

salut zeb,

ah oui, dsl pour l'oubli des déclaration de first_row et last_row..
sinon j'ai regardé ton code parcequ'il y avait des fonctions que je ne connaissais pas !!

Par contre il y a des erreurs de syntaxe (je pense).
linecopy n'existe pas sous VBA donc je présume que c'est line.copy qui est bon (je ne connaissais pas l'existence de line... cool)
ensuite je ne connaisait pas non plus cette syntaxe pour copy (avec les virgules) et du coup, n'aillant rien trouvé sur l'aide, a quoi sert les ",True " a la fin de lignes ?
et pourquoi les mettre que de temps en temps ?

cell_D.EntireRow.Copy, unmatched, True

Autre question, l'utilisation de Clear supprime le contenu des lignes non ? parceque moi j'aimerais que la feuille 1 reste telle qu'elle est initialement. EDIT: d'ou la copie en début de code ^^ mais par contre, bug: objet requis
sinon, merci !!!!!!!

maintenant (et non, c'est pas fini) je souhaite que pour les unmatched on fasse un autre test :
faire tous les calculs de somme possible jusqu'a ce que une somme de débit + somme crédit = +/- 0.05 (en avancant chronologiquement,dc ds l'ordre des ligne parceque le tableau est trié de la plus vieille date a la plus récente)
sachant qu'apres je demanderai a l'utlisateur de rentrer la marge qu'il souhaite.
Je me suis pas encore penché dessus mais cette nuit j'ai pensé utilisé la boucle do ... loop until
je m'y met ...

(   je fais des reves de programmation !!!   )

Quelles erreurs de syntaxe ?
Bon, il y avait deux trois bricoles que je viens d'éditer.

Mais la fonction LineCopy() existe, c'est moi qui l'ai inventée. Relis mon message précédent.

(Fais de beaux rêves   )

pfiou,
je suis fatigué !! j'avais completement zapé la fonction que tu avais crée...

par contre j'ai une erreur objet required "424" sur cette ligne

Set ws_source = Worksheets("Mastersheet").Copy(After:=Worksheets(Worksheets.Count))

et je n'arrive pas a l'expliquée.. (Set est bien présent), Mastersheet existe, la copy est bonne etla destination semble l'etre aussi puisqu'il me le copie correctement !..

pour ma boucle j'ai pensé faire qqch comme ca : (je l'integre apres dans le premier programme)

Sub sommesCumulee()

 
Dim j As Long

Dim ligne As Long

Dim ligne1 As Long

Dim ws_proposal As Worksheet

Dim ws_unmatched As Worksheet

dim somme_cumulee as double

 
Set ws_unmatched = Worksheets("Other")

Set ws_proposal = Worksheets("Matched Proposal")

 
j = 2

Do

    Do

        For ligne = j To ws_unmatched.Columns(7).End(xlDown).Row

          somme_cumulee = Cdbl(ws_unmatched.Cells(ligne, 7).Value) + Cdbl(ws_unmatched.Cells(ligne, 8).Value)

        Next

    Exit Do

    Loop Until Abs(somme_cumulee) <= 0.05

    For ligne1 = j To ws_unmatched.Columns(7).End(xlDown).Row

        LineCopy ws_unmatched.Rows(ligne1), ws_proposal.Rows

    Next

j = j + 1

Exit Do

Loop Until j = unmatched.Columns(7).End(xlDown).Row

 
End Sub

Set ws_source = Worksheets("Mastersheet" ).Copy(After:=Worksheets(Worksheets.Count))

Arrgggggh ! Saloperie de VBA de me qu'est pas fichu d'avoir un modèle objet complet

Worksheets("Mastersheet" ).Copy(After:=Worksheets(Worksheets.Count))
Set ws_source = Worksheets(Worksheets.Count)

Je vois encore des variables non déclarée. Est-ce :
[ ] par égard pour le forum, pour ne pas alourdir les messages,
[ ] par oubli, mais c'est la dernière fois,
[ ] parce que tu as encore oublié à cause du fait que tu n'utilises pas l'option explicite
[ ] obiwan kenobi - la réponse D
?

(Si tu oses me répondre que c'est parce que tu t'en carres de l'option explicite, j'te cause plus   )

réponse D : obiwan Kenobi !!!!  
dsl c'est un pur méga oubli..   (sur quel code ? le dernier ? (edit fait sur le premier))
ms VBA est pourri la dessus aussi.. il ne devrait pas faire tourner le code !!!

edit: oups ma somme !!!!!

j'ai avancé ma somme cumulée... mais marche pas..

Dim j As Long

Dim k As Long

Dim ligne As Long

Dim ligne1 As Long

Dim ws_proposal As Worksheet

Dim ws_unmatched As Worksheet

Dim somme_cumulee As Double

 
Set ws_unmatched = Worksheets("Other")

Set ws_proposal = Worksheets("Matched Proposal")

 
j = 2

k = ws_unmatched.Columns(2).End(xlDown).Row

 
For ligne = j To k

    Do

        somme_cumulee = CDbl(ws_unmatched.Cells(ligne, 7).Value) + CDbl(ws_unmatched.Cells(ligne, 8).Value)

        j = j + 1

    Exit Do

    Loop Until Abs(somme_cumulee) <= 0.06 Or j = k

    If Abs(somme_cumulee) <= 0.05 Then

        For ligne1 = j To ligne

            ws_unmatched.Rows(ligne1).Copy ws_proposal.Rows(2)

        Next

    End If

Next

Bon, je suis dans un bon jour, alors si tu me promets de ne plus mettre de : après tes Else (tu m'énerves avec ça   ), si tu acceptes d'étudier un peu ce code, et si en plus tu inventes toi-même la fonction ZoneCopy(), alors je t'invite à accepter ça :

Dim plage  As Range
Dim cell   As Range
Dim zone   As Range
Dim valeur As Double
Dim cumul  As Double
 
Set zone = Nothing
For Each cell In plage
    If Trim(cell.Offset(, 5).Value) <> "" And _
       Trim(cell.Offset(, 6).Value) = "" _
    Then
        ' // C'est parti !
        Set zone = cell.Offset(, 5)
    Else
        If zone Is Nothing Then
            ' // Ca n'a pas encore commencé
        Else
            ' // La zone est enrichie
            Set zone = zone.Worksheet.Range(zone.Cells(1), cell.Offset(, 6))
 
            ' // Un peu de calcul
            valeur = zone.Cells(1, 1).Value
            cumul = WorksheetFunction.Sum(zone.Columns(2))
 
            If Abs(valeur - cumul) < 0.05 Then
                ' // Yeah !!!
                ZoneCopy zone, target, True
 
                ' // On remet les compteurs à zéro
                Set zone = Nothing
            End If
        End If
    End If
Next

Ah, j'oubliais. Faut gérer target et en plus, ça ne fait que la moitié du boulot. Faut recommencer pour les débits (ou les crédits, je ne sais plus).

 

------------
[private]
Je suis trop content de te voir aider les autres en leurs faisant suivre certains de mes préceptes. Je ne détiens pas la Vérité Absolue, et on peut encore m'en apprendre, mais ceux-ci viennent d'années d'expérience et savoir que c'est transmis au moins pour partie me remplit de plaisir  

Salut zeb,

Alors, j'ai un peu regardé ta propostion de code (celle remplacant mon code au début de la disussion) maisil s'avere que je peine a le faire fonctionner, le deboggeur m'envoyant de erreur 1004 application objet defined error a la volée !!

Je n'ai ps encore eu le tps de jeter un coup d'oeil a ta derniere proposition de code sur la somme cumullee mais je m'apprete a le faire. Pour ce qui est du fait qu'il ne marche que pour une colonne, tant mieux, parce que je n'ai pas toujours 2 colonnes !! parfois j'ai les débit et les crédits dans la meme colonne !! (ben oui franchement, pourquoi faire simple !!!   )
Du coup je vais m'inspirer de ta méthode et l'adapter fortement a mon cas !!

SInon une question : je remarque que tu propose souvent des méthode avec des range
Excel met moins de tps a executer le code VBA lorsque je lui délimite le tableau d'entrée mais tu dis que mes adresses de Range sont pas top top... du coup que privilégier ?

---------
[private]

Mais de rien, ca fait toujours plaisir d'aider les autres (qd je peux !!!   ). En plus ce forum est sérieux et sympa !!!

re,

je viens de regarder le code et j'ai du faire qqs modifs e cause de ce ***** de VBA :

Set cell_D = ws_source.Columns(8).Cells

j'ai du enlever les .offset (erreur 1004 object defined error). J'ai déja remarquer qu'il ne les aime pas trop ceux la !!

pour les Trim() j'ai regardé l'aide (je connaissait pas): ne s'utilise que sur des expressions String.. or j'ai des montants dans mes cases d'ou l'erreur 13 : type mismatch. par contre qd mes cellules sont vides il bloque aussi or le vide peut etre en n'importe quel format nn ?
..
j'avance pour le reste !

Eh, pour les Trim(), en VBA, en VB, en ksh, en SQL, partout j'en mets. On n'est pas à l'abri d'un espace oublié. Mais peut être faut-il alors écrire :

If Trim(cellule.Text) Then

Si tu as des erreurs 1004, ce n'est pas Offset() qui pose problème, mais l'objet juste avant.

Effectivement, il faut dans certains cas ajouter .Cells, même sur un objet Range. VB est mal écrit  

pfiou !

apres quelques retouches c'est effectivement le .value qui bloquait.
ok, le programme tourne, je me penche maintenant sur celui des sommes cumulées.
je pense que je vais surtout me resservir de la méthode d'enrichissement de zone !!!

j'attaque

Taïaut !!!!!!!!!!!!

coucou,

bon j'ai pas avancé sur la somme mais par contre je corrige quelques erreurs sur le code précédent et en lancant ce dernier j'ai remarqué que Find me trouve TOUTES les cellules égales a celle qu'il recherche.
Or moi, pour que la somme des 2 fasse 0 il ne m'en faut qu'une !!!

d'ou ma question y a t'il un argument non présent dans l'aide qui completerai .FIND() pour qu'il s'arrete qd il a trouver une cellule identique.
ci dessous la partie de mon code correspondante

[...]

For i = first_row + 1 To last_row

    'execute le code pour les cellules non vide et au format numerique de la colonne montant

    vide = ws_source.Cells(i, col).Value = ""

 
    If Not vide Then

        Select Case ws_source.Cells(i, col).Value

            Case Is < 0: Set cells_found = Range(Cells(i + 1, col), Cells(last_row, col)).Find(Abs(ws_source.Cells(i, col).Value), lookat:=xlWhole)

            Case Is > 0: Set cells_found = Range(Cells(i + 1, col), Cells(last_row, col)).Find((ws_source.Cells(i, col).Value * -1), lookat:=xlWhole)

            Case Is = 0: ws_source.Rows(i).Copy matched: Set matched = matched.Offset(1)

        End Select

 
        If Not cells_found Is Nothing Then

            [...]

Salut,

M'enfin, un simple Exit For pour sortir de ta boucle quand tu as trouvé, et c'est tout ! C'est pas comme si je t'avais pas déjà proposé ce type de code.

Eh oui, tout ce que je te propose est à étudier, pas à copier bêtement  

 

salut zeb,

tkt, je ne recopie rien betement ce serai trop dommage !!
Par contre un simple exit for... je veux bien mais dans ma configuration actuelle, si je met un simple exit for il arretera de me faire les recherches pour les autres lignes non ?

ou alors il quitte juste la boucle en cours (et dans ce cas j'ai un mega point de base a revoir !!!   )

Arfff. Je n'avais pas tout lu.
Du coup, je ne comprends pas la question :

et bien en fait moi je veux qu'il ne trouve qu' UNE seule des cellules possible.

pour -26000 il doit trouver 26000 mais qu'une seule fois pour que -26000 + 26000 = 0
si il me trouve 4 fois 26000 je me retrouve avec une balance différente de 0 !!

en fait je pense que du coup FIND n'est pas approprié ou qu'on peut lui ajouter un paramètre supplémentaire... mais lequel.. rien ds l'aide

salut,
je n'arrive pas avec find alors j'ai chercher une autre fonction qui ne renvoyait l'adresse que d'une seule occurence (la premiere) et j'ai trouvé INSTR() pour les string mais moi il me faudrait un équivalent pour les nombres et je trouve pas..

Euh.....
J'étais à l'instant en train de te répondre que je ne comprenais rien à ton baratin, que Find() ne renvoyait qu'une cellule à la fois, etc. Quand j'ai enfin compris ton problème. Ouf !!!!!

Quand tu prends en compte la ligne i (courante) et la ligne j=i+n (renvoyée par Find()), tu prends bien la peine, grâce à l'itération (la boucle For) de ne pas reconsidérer la ligne i, mais dans un prochain tour, tu peux reconsidérer la ligne j, pour un i différent.

D'où mes propositions :

Travailler sur une feuille temporaire pour pouvoir y faire des coupes sombres.

Vider les lignes prises en compte.

Rappel :

Sub LineCopy(ByVal Line As Range, ByRef target As Range, Optional Clear As Boolean)

    Line.EntireRow.Copy Destination:=target

    Set target = target.Offset(1)

    If Clear Then Line.Clear

End Sub

Réétudier ce code. Comprendre l'intérêt de la ligne 4  



 

ben j'ai bien compris l'interet de ta fonction maisje pensais que mon .hidden faisait la meme chose...

ca fait 2 jours que je m'arrache les cheveux la dessus... j'ai l'impression de ne plus avancer et de ne plus voir les fautes dans les codes... c'est pas bon.
en plus je manque de tps, mon boss me presse pour finir ce code pour qu'il puisse l'envoyer a tt le monde ...grrr

?!?!?!?!?!?!?!? Mais non. Les choses cachées existent quand même. Ce n'est pas parce que tu n'as jamais vu de rennes volants que le Père Noël n'existe pas.

Code :

Range("B3").Value = "Père Noël"
Rows(3).Hidden = True
Columns("B").Hidden = True
 
MsgBox "Le " & Range("B3").Value & " existe, il se cache dans la cellule " & Cells.Find("Père Noël").Address(False, False)

ZEb tu es GENIAL !!!!

je viens de comprendre ce que tu disais avec les lignes (avant de voir ton mess !!!   )
Du coup j'ai remplacé tous mes horibles . hidden et j'ai réutilisé ta fonction linecopy ()
c'est genial, ca marche super bien et tres rapidement.
ci desous le code quand il y a une seule colonne avec les montants D et C

Sub LineCopy(ByVal Line As Range, ByRef target As Range, Optional Clear As Boolean)

    Line.EntireRow.Copy Destination:=target

    Set target = target.Offset(1)

    If Clear Then Line.Clear

End Sub

 
Sub reconciliation2() 'tableau avec une colonne montant (crédit et débit inclus) et transaction

 
Dim ws_source As Worksheet

Dim matched As Range

Dim cells_found As Range

Dim unmatched As Range

Dim i As Long

Dim j As Long

Dim first_row As Long

Dim last_row As Long

Dim col As String

Dim somme_col As Double

Dim ws_match As Worksheet

Dim lstrow As Long

Dim clear_result As Range

 
Set ws_source = Worksheets("Mastersheet")

Set matched = Worksheets("Matched").Rows(2)

Set unmatched = Worksheets("Other").Rows(2)

Set ws_match = Worksheets("Matched")

Set clear_result = Worksheets("Clear Matched results").Rows(16)

 
demand = MsgBox("Is there Merge cells/column on the table ?", vbYesNoCancel)

If demand = vbYes Then

    ws_source.Columns(4).Delete 'delete merged cells

    ws_source.Columns(8).Delete

ElseIf demand = vbCancel Then

    Exit Sub

End If

ws_source.Cells.Copy Worksheets("Report1").Cells 'sauvegarde du raport intact

 
' find first and last row of the table

first_row = ws_source.Range("B1").End(xlDown).Row

last_row = ws_source.Cells(first_row, 2).End(xlDown).Row

 
With ws_source.Rows(first_row)

    .Copy Worksheets("Matched").Rows(1)

    .Copy Worksheets("Other").Rows(1)

End With

 
col = UCase(InputBox("Enter the Name of the Amount column :"))

MsgBox "" & col

 
For i = first_row + 1 To last_row

    'execute le code pour les cellules non vide et au format numerique de la colonne montant

    vide = ws_source.Cells(i, col).Value = ""

 
    If Not vide Then

        Select Case ws_source.Cells(i, col).Value

            Case Is < 0: Set cells_found = Range(Cells(i + 1, col), Cells(last_row, col)).Find(Abs(ws_source.Cells(i, col).Value), lookat:=xlWhole, searchdirection:=xlNext)

            Case Is > 0: Set cells_found = Range(Cells(i + 1, col), Cells(last_row, col)).Find((ws_source.Cells(i, col).Value * -1), lookat:=xlWhole, searchdirection:=xlNext)

            Case Is = 0: LineCopy ws_source.Rows(i), matched, True

        End Select

 
        If Not cells_found Is Nothing Then ' meme montant trouvé

            ligne = cells_found.Row

            LineCopy ws_source.Rows(ligne), matched, True

            LineCopy ws_source.Rows(i), matched, True

 
        Else

            LineCopy ws_source.Rows(i), unmatched, True  ' pas trouvé donc copie dans Other

        End If

 
    End If

Next

 
'mise en forme dans le tableau prévu clear results

lstrow = ws_match.Columns(2).End(xlDown).Row 'nombre d'opérations réconciliées

k = 1

Do

    Worksheets("Clear Matched results").Rows(17).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    k = k + 1

Loop Until k = lstrow

 
For j = 2 To lstrow

    If ws_match.Cells(j, col).Value < 0 Then

        ws_match.Cells(j, col).Copy clear_result.Cells(, 3)

        ws_match.Cells(j, 6).Copy clear_result.Cells(, 1)

    ElseIf ws_match.Cells(j, col).Value > 0 Then

        ws_match.Cells(j, col).Copy clear_result.Cells(, 4)

        ws_match.Cells(j, 6).Copy clear_result.Cells(, 1)

    Else

        ws_match.Cells(j, col).Copy clear_result.Cells(, 4)

        ws_match.Cells(j, 6).Copy clear_result.Cells(, 1)

    End If

    Set clear_result = clear_result.Offset(1)

Next

End Sub

il ne me reste plus qu'a ajuster le programme pour le cas ou C et D sont dans ds colonnes différentes !!

(ne m'en veux pas mais pendant tout ce temps je n'avais pas utiliser ta fonction bien que comprise parce que je voulais absolument reussir avec mon début de programme et comprendre pourquoi il ne marchait pas. ca m'apprendra a etre tétu !!)

je reviens sur ce que j'ai dit... il ya encore des petites erreurs.
en fait lorsque j'ai trois op2rations expl :100 puis -100 et encore -100
il me copie bien le100 et le -100
mais apres, comme find a trouver le deuxieme -100: il copie la ligne originale (cleared donc une ligne vide) et la ligne avec le 2eme -100...

comment endigué cela ?

edit: j'ai le meme probleme sur l'autre code

Ma fonction n'était pas à utiliser, mais à étudier, puis à adapter.
Après si le code que je fournis est suffisamment générique pour resservir tel quel   (<-- crâneur)



EDIT: A ben c'était bien la peiner de crâner, tiens !!  

Wahou, j'avais pas décortiqué ça :

Select Case ws_source.Cells(i, col).Value

    Case Is < 0: Set cells_found = Range(Cells(i + 1, col), Cells(last_row, col)).Find(Abs(ws_source.Cells(i, col).Value), lookat:=xlWhole, searchdirection:=xlNext)

    Case Is > 0: Set cells_found = Range(Cells(i + 1, col), Cells(last_row, col)).Find((ws_source.Cells(i, col).Value * -1), lookat:=xlWhole, searchdirection:=xlNext)

    Case Is = 0: ...

Petit rappel de math :

Par ailleurs, si x est strictement négatif : Abs(x) = -x

Donc ton bazar peut s'écrire plus simplement (Sauf que je rajoute les ws_source oubliés   ) :

If ws_source.Cells(i, col).Value <> 0 Then

    Set cells_found = ws_source.Range(ws_source.Cells(i + 1, col), ws_source.Cells(last_row, col)).Find(-ws_source.Cells(i, col).Value, lookat:=xlWhole, searchdirection:=xlNext)

 
    ' // Et ça laisse de la place pour mettre des trucs ici !

 
Else

    LineCopy ws_source.Rows(i), matched, True

End If

Bon, comme on a de la place là ou je dis qu'il y a de la place (   ), tous les trucs qui viennent après, de ta ligne 61 à ta ligne 68, on va pouvoir les y coller.
Parce que en l'état, si on est passé par la case 0 ( Case Is =0 ), on passe aussi par ce code, et ça, c'est pas terrible.

(le ton volontairement goguenard employé est destiné à t'inciter à plus de rigueur, la prochaine fois   )

non, mais il n'y a aucune erreur sur la fonction, je pense.
mais ca m'énerve cette histoire de double résultat!!

comme tu as posté juste avant..

(Plus je relis ton code, plus je refais des exemples en reprenant ton code, et plus je trouve que l'utilisation d'objets Range plutôt que de variables entières est élégant (c'est un avis discutable) et simple (peut être pas au premier abord)

' // first_row = ws_source.Range("B1" ).End(xlDown).Row
first_cell = ws_source.Range("B1" ).End(xlDown)
 
' // last_row = ws_source.Cells(first_row, 2).End(xlDown).Row
last_cell = first_cell.End(xlDown) ' // <-- Ah, déjà, c'est plus simple !
 
' // With ws_source.Rows(first_row)
With first_cell.EntireRow ' // <-- Pas plus simple. Différent, logique.
    .Copy Worksheets("Matched" ).Rows(1)
    .Copy Worksheets("Other" ).Rows(1)
End With
 
col = UCase(InputBox("Enter the Name of the Amount column :" ))
MsgBox "" & col
 
' // For i = first_row + 1 To last_row
For Each cell In ws_source.Range(first_cell.Offset(col - 2), last_cell.Offset(col - 2)) ' // <-- Un peu moins simple. Mais seulement ici.
 
    ' // vide = ws_source.Cells(i, col).Value = ""
	' // If Not vide Then
 
	If cell.Value <> "" Then ' // Trop simple
	    If cell.Value <> 0 Then
	        Set cells_found = ws_source.Range(cell, last_cell).Find(-cellValue, lookat:=xlWhole, searchdirection:=xlNext)
		    If Not cells_found Is Nothing Then ' meme montant trouvé
		        ' // ligne = cells_found.Row
	    	    ' // LineCopy ws_source.Rows(ligne), matched, True
	        	' // LineCopy ws_source.Rows(i), matched, True
	    	    LineCopy cell.EntireRow, matched, True         ' // C'est pas dix fois 
	        	LineCopy cell_found.EntireRow, matched, True   ' // plus simple ?
        	Else
            	' // LineCopy ws_source.Rows(i), unmatched, True  ' pas trouvé donc copie dans Other
            	LineCopy cell.EntireRow, unmatched, True ' // C'est pas cent fois plus simple ?
        	End If
        Else
        	' // LineCopy ws_source.Rows(i), matched, True
        	LineCopy cell.EntireRow, matched, True ' // C'est pas mille fois plus simple ?
		End If

Je ne t'impose rien. Ça s'appelle du style, et chaque auteur peut avoir le sien, sans que l'un soit mieux que l'autre. Mais je serai curieux de connaître ton avis sur le sujet   )

salut zeb,

Je suis d'accord avec toi sur le fait que l'utilisation de range simplifie grandement le code (dans la plupart des cas et si les range sont explicitement déclarés !!).
mais c'est sur que la tu as fait fort !!

le code est tres lisible et tres compréhensible. !!!

par contre ligne 17 ma variable col est un string.. je ne pense pas qu'excel comprenne le offset(col -2).

mais sinon j'approuve a 100 %

je poste mon code tel qu'il était avant...

Dim ws_source As Worksheet

Dim matched As Range

Dim cells_found As Range

Dim unmatched As Range

Dim i As Long

Dim first_row As Long

Dim last_row As Long

Dim col As String

Dim ws_match As Worksheet

Dim lstrow As Long

Dim temp As Worksheet

Dim demand As Variant

Dim vide As Boolean

Dim ligne As Long

Dim somme As Double

 
Set ws_match = Worksheets("Matched")

Set ws_source = Worksheets("Mastersheet")

Set matched = ws_match.Rows(2)

Set unmatched = Worksheets("Other").Rows(2)

 
 
demand = MsgBox("Is there merge columns on the table ?", vbYesNoCancel)

If demand = vbYes Then

    ws_source.Columns(4).Delete 'delete merged cells

    ws_source.Columns(8).Delete

ElseIf demand = vbCancel Then

    Exit Sub

End If

 
' find first and last row of the table

first_row = ws_source.Range("B1").End(xlDown).Row

last_row = ws_source.Cells(first_row, 2).End(xlDown).Row

 
col = UCase(InputBox("Enter the Name of the Amount column :"))

MsgBox "You have written " & col & " for the column name. ", vbOKOnly

 
somme = WorksheetFunction.Sum(ws_source.Columns(col).Cells)

If Abs(somme) <= 0.05 Then

    ws_source.Range(Cells(first_row, 1), Cells(last_row, 10)).Copy matched.Offset(-1) 'si somme = 0 alors copie dans matched

Else

    With ws_source.Rows(first_row)

        .Copy ws_match.Rows(1)

        .Copy Worksheets("Other").Rows(1)

    End With

 
    Set temp = Worksheets.Add

    ws_source.Cells.Copy temp.Cells 'sauvegarde du raport intact

 
    For i = first_row + 1 To last_row

        'execute le code pour les cellules non vide et au format numerique de la colonne montant

 
        If ws_source.Cells(i, col).Value <> 0 Then

            Set cells_found = ws_source.Range(ws_source.Cells(i + 1, col), ws_source.Cells(last_row, col)).Find(-ws_source.Cells(i, col).Value, lookat:=xlWhole, searchdirection:=xlNext)

 
            If Not cells_found Is Nothing Then ' meme montant trouvé

                ligne = cells_found.Row

                LineCopy ws_source.Rows(ligne), matched, True

                LineCopy ws_source.Rows(i), matched, True

            Else

                LineCopy ws_source.Rows(i), unmatched, True ' pas trouvé donc copie ligne dans Other

            End If

        Else

            LineCopy ws_source.Rows(i), matched, True

        End If

    Next

 
    Application.DisplayAlerts = False

    temp.Cells.Copy ws_source.Cells

    temp.Delete 'suppression feuille temporaire

 
End If

et je vais le modifier pour voir ce que ca donne avec ce que tu propose....  

re,

ALors, en appliquant et corrigeant quelques fautes de frappes j'arrive a un résultat plus que satisfaisant !! mes lignes vides ont disparues ... et mon code est plus compréhensible (merci a la fonction aussi !!!)

j'arrive a ce résultat :

Dim ws_source As Worksheet

Dim ws_match As Worksheet

Dim first_cell As Range

Dim last_cell As Range

Dim cell As Range

Dim cells_found As Range

Dim matched As Range

Dim unmatched As Range

Dim somme As Double

Dim demand As Variant

Dim col As Long

Dim temp As Worksheet

 
Set ws_source = Worksheets("Mastersheet")

Set ws_match = Worksheets("Matched")

Set matched = ws_match.Rows(2)

Set unmatched = Worksheets("Other").Rows(2)

 
demand = MsgBox("Is there merge columns on the table ?", vbYesNoCancel)

If demand = vbYes Then

    ws_source.Columns(4).Delete 'delete merged cells

    ws_source.Columns(8).Delete

ElseIf demand = vbCancel Then

    Exit Sub

End If

 
' trouve premiere et derniere cellule pleine dans B1

Set first_cell = ws_source.Range("B1").End(xlDown)

Set last_cell = first_cell.End(xlDown)

 
' copie en-tete du tableau

With first_cell.EntireRow

    .Copy Worksheets("Matched").Rows(1)

    .Copy Worksheets("Other").Rows(1)

End With

 
col = UCase(InputBox("Enter the NUMBER of the Amount column :"))

MsgBox "" & col

 
Set temp = Worksheets.Add 'sauvegarde du raport intact

ws_source.Cells.Copy temp.Cells

 
somme = Abs(Round(WorksheetFunction.Sum(ws_source.Columns(col).Cells), 2))

If somme <= 0.05 Then

    ws_source.Range(first_cell.EntireRow, last_cell.EntireRow).Copy matched.Offset(-1) 'si somme = 0 alors copie dans matched

Else

 
    For Each cell In ws_source.Range(first_cell.Offset(1, col - 2), last_cell.Offset(, col - 2)) ' pour chaque cellule du tableau de la colonne col

 
       If cell.Value <> "" Then ' uniquement les cellules pleines

            If cell.Value <> 0 Then

                Set cells_found = ws_source.Range(cell, last_cell).Find(-cell.Value, lookat:=xlWhole, searchdirection:=xlNext)

                If Not cells_found Is Nothing Then ' meme montant trouvé

                    LineCopy cell.EntireRow, matched, True

                    LineCopy cells_found.EntireRow, matched, True

                Else

                    ' pas trouvé donc copie dans Other

                    LineCopy cell.EntireRow, unmatched, True

                End If

            Else

                ' copie dans match les opérations nulles

                LineCopy cell.EntireRow, matched, True

            End If

        End If

    Next

 
    Application.DisplayAlerts = False 'suppression feuille temporaire

    temp.Cells.Copy ws_source.Cells

    temp.Delete

End If

comm on dit en anglais : Brillant !!

 

A la place des lignes 37, 38 et pour répondre à ton problème de col qui est une chaîne de caractères :

Dim userinput As String

Dim col       As Integer

 
userinput = InputBox("Never trust user input")

If IsNumeric(userinput) Then

    col = Columns(CInt(userinput)).Column

Else

    col = Columns(userinput).Column

End If

Pour la ligne 48, j'ai un tout petit peu mieux à te reproposer (code hyper-générique  ) :

For Each cell In ws_source.Range(first_cell, last_cell).Offset(, col - first_cell.Column)

Et surtout, correction de gros bug !!!!!!!!!!
Ligne 67, tu désactives les messages d'alerte. Or je ne vois pas que tu les réactives.

T'as gagné une meilleure réponse, sélectionnée par zeb.

Bon, j'ai tout relu, et je trouve encore un truc à redire.
(Quand je bossais outre-manche, on me surnommait the perfectionnist   ).

Il est plus convenable de traiter les données de la copie plutôt que celle de l'original. A l'issue du traitement, plutôt de d'écraser l'original avec la sauvegarde, puis de supprimer celle-ci, il suffit de supprimer la sauvegarde.

C'est plus simple, mais c'est surtout plus prudent. Si pour une raison quelconque, ton processus n'aboutit pas, tes données originales ne sont pas altérées.

A la ligne 14, tu écris :

Set ws_source = Worksheets.Add

Worksheets.("Mastersheet").Cells.Copy ws_source.Cells

Tu supprimes ensuite la ligne 75, et à suivante, tu mets ws_source à la place de temp. C'est plus joli, non ?

décidément tu n'es jamais a court d'idées !!!
Oui, c'est plus joli et plus prudent !!  

merci, merci !!  

Jamais !!!
Je ne re-relis pas ton code, de peur de re-retrouver un truc à dire