XL 2010 modifier une macro excel 2002

Ferbank

XLDnaute Occasionnel
Bonjour je m'en remets à vous pour apporter une correction sur une macro qu j'ai modifié ou peut être malmenée.
Je vous remercie encore JOB75 pour la conception de ette macro.
Peut être es ce possible de la modifer simplement.

Je n'ai toujours pas gagné au loto mais de voir le fonctionnement de la macro me satisfait largement.
bon courage à vous.
Ferbank
 

Pièces jointes

  • EUROMILLON 2021 Octobre2021_macro_nov.xls
    553 KB · Affichages: 6

Ferbank

XLDnaute Occasionnel
Bonjour Ferbank,

Tout ce que je connais c'est cette discussion :

https://www.excel-downloads.com/threads/formule-excel-version-2007.20038939/

Si vous voulez modifier quelque chose indiquez de quel numéro de post vous partez.

Et expliquez clairement ce que vous voulez.

A+
Bonjour et merci pour votre réponse; en fait vous m'aviez edité une macro pour un tri et recherche de n° sur un ficher excel pour le jeu du loto.

J'ai transposé cette macro sur un fichier identique pour l'euromillon , j'ai rajouté une formule de recherche "col AG "sur les resultats obtenu par la macro.
Helas, à chaque modif de recherche, une erreur se produit sur ma formule col AG, la rend invalide puisque le bloc de recherche est issu d'une macro: voir le fichier joint au précedent message.
Je n'arrive pas à modifier correctement la macro pour differencier la recherche sur les N° complementaires col J et K; pour des resultats afficher en col Y et Z pour cela il faut decaler la colonne des dates en Z j'obtiens une erreur.
je joints le fichier correct sans modif.
merci
 

Pièces jointes

  • EUROMILLON 2021 Novembre 2021 Exeldowload.xls
    655 KB · Affichages: 6

job75

XLDnaute Barbatruc
Bonjour Ferbank,

La macro ne créera plus de problème en remplaçant :
VB:
Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).Delete xlUp 'RAZ
par :
VB:
Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).ClearContents 'RAZ
J'utilisais Delete pour le cas où il y aurait dans la plage des formatages particuliers mais ce n'est pas le cas.

A+
 

Pièces jointes

  • EUROMILLON 2021 Novembre 2021 Exeldowload (1).xls
    609.5 KB · Affichages: 9

Ferbank

XLDnaute Occasionnel
A merci super la macro! ça en devient marrant qu'en ça fonctionne j'ai toujours le plaisir de constater le resultat d'une formule.
Mais pour mon deuxième prob sur la recherche des N° compl associés ou pas, aux N° barre jaune T11 à X11 c'est un autre prob,
il faut decaler la colonne Z des dates, pour creer une zone de recherche en Y11 et Z11 et laà je cale..
 

job75

XLDnaute Barbatruc
Pour pouvoir faire une recherche sur 2 plages voyez ce fichier (2) et la macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Recherche1 As Range, Recherche2 As Range, Recherche As Range, P1 As Range, P2 As Range, P As Range
Dim Dates As Range, c As Range, Q As Range, R As Range
Set Recherche1 = [T11:X11]
Set Recherche2 = [Y11:Z11]
Set Recherche = Union(Recherche1, Recherche2)
If Intersect(Target, Recherche) Is Nothing Then Exit Sub
Set P1 = [E:I]
Set P2 = [J:K]
Set P = Union(P1, P2)
Set Dates = [D:D]
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
'Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).Delete xlUp 'RAZ
Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).ClearContents 'RAZ
For Each c In Recherche1
    If c <> "" Then
        P1.Replace c, "#N/A", xlWhole
        Set Q = Nothing
        Set Q = P1.SpecialCells(xlCellTypeConstants, 16)
        If Q Is Nothing Then Exit Sub
        Q = c
        Set Q = Intersect(Q.EntireRow, P)
        If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
        If R Is Nothing Then Exit Sub
    End If
Next
For Each c In Recherche2
    If c <> "" Then
        P2.Replace c, "#N/A", xlWhole
        Set Q = Nothing
        Set Q = P2.SpecialCells(xlCellTypeConstants, 16)
        If Q Is Nothing Then Exit Sub
        Q = c
        Set Q = Intersect(Q.EntireRow, P)
        If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
        If R Is Nothing Then Exit Sub
    End If
Next
'---résultat---
R.Copy Recherche(2, 1)
Intersect(R.EntireRow, Dates).Copy Recherche(2, Recherche.Columns.Count + 1)
End Sub
A+
 

Pièces jointes

  • EUROMILLON 2021 Novembre 2021 Exeldowload(2).xls
    612.5 KB · Affichages: 9

Ferbank

XLDnaute Occasionnel
ok merci je crois que je vais y passer une partie de la nuit pour comprendre et comparer l'ecriture de la macro!
je rêverai d'avoir vos capacités à resoudre ce problème!
c'est quand même formidable de faire parler une macro
merci encore !
je m'y attache de suite
Ferbank
 

Discussions similaires

Réponses
2
Affichages
391
Réponses
1
Affichages
595