Inputbox avec dates

Version imprimable

04/10/2023, 15h08
lourid

1 pièce(s) jointe(s)

Inputbox avec dates

J'aurais besoin d'extrapoler des données avec une date antérieure à celle que j'insère dans une "inputbox"
Les données à extraire se trouvent dans la feuille Ratei (A2:AL452) la colonne de comparaison en P2 (date di cessazione)
Les données doivent être copiées dans la feuille CEX

exemple, si je saisis 01/09/2023 dans l'inputbox , je dois copier les données dont la date de fin est antérieure au 1er septembre dans la feuille cex et les supprimer de la feuille Ratei

je joins le fichier

Bonjour,
L'InputBox n'est jamais qu'une interface qui nous permet d'entrer une valeur mais cela pourrait provenir de la valeur présente dans une cellule ou une valeur issue d'un TextBox d'un USerForm
Donc une fois que cette valeur est connue et placée dans une variable, il nous reste à filtrer les données soit par la méthode AutoFilter de l'objet Range soit avec la méthode AdvancedFilter du même objet ce dernier permettant d'exporter suivant critère
Si l'on a opté pour la méthode AutoFilter et après avoir filtré les données, il faudra définir les cellules visibles à l'aide de la propriété SpecialCells avec comme argument, la constante xlCellTypeVisible
Ensuite on fait la même chose pour la suppression des données mais en excluant la ligne des titres et on utilise la méthode Delete

Voici un exemple
Dans cet exemple le filtre se fait sur la colonne 9 (il y a lieu pour rendre dynamique la procédure de faire une recherche sur la position de la colonne à filtrer (la fonction EQUIV/MATCH (en anglais et en VBA) permet de le faire)
Il reste à régler le fait que la feuille cible contient sans doute , mais vous ne le précisez pas, des données provenant d'exportations précédentes, il y aura lieu alors de repérer la prochaine ligne où coller les données et dans ce cas il faudra exclure également la ligne des titres.
Pour cet exemple la plage des données doit être seule dans la feuille source.

J'ai utilisé une cellule (O1) pour placer la date qui servira de critère
Les plages source et cible pour l'exemple commencent en cellule A1
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Sub t() ' Déclaration des variables et constante Const SheetSource As String = "Source" ' Nom de la feuille source Const SheetTarget As String = "Cible" ' Nom de la feuille cible Dim shtSource As Worksheet Dim shtTarget As Worksheet Dim oRange As Range ' Plage source Dim oRangeFiltered As Range ' Plage source filtrée Dim myDate As Long ' Affectation des variables With ThisWorkbook Set shtSource = .Worksheets(SheetSource) Set shtTarget = .Worksheets(SheetTarget) End With myDate = shtSource.Range("O1").Value ' Date du filtre Set oRange = shtSource.Range("A1").CurrentRegion ' Début With oRange .AutoFilter Field:=9, Criteria1:="<" & myDate ' Définit la plage filtrée avec la ligne des titres Set oRangeFiltered = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) oRangeFiltered.Copy Destination:=shtTarget.Range("A1") ' Copie des données ' Définit la plage filtrée sans la ligne des titres Set oRangeFiltered = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) oRangeFiltered.EntireRow.Delete ' Suppression des données End With Set oRange = Nothing: Set oRangeFiltered = Nothing: Set shtSource = Nothing: Set shtTarget = Nothing End Sub

05/10/2023, 09h15
lourid

1 pièce(s) jointe(s)

Merci Philipphe
Je joins le fichier avec les résultats avec le 1/09/2023 comme paramètre de recherche in colonne P.
Dans la feuille cex tous les enregistrements antérieurs à cette date
le problème c'est que la date change à chaque fois et je ne veux pas l'écrire à la main dans la cellule.
05/10/2023, 09h20
Philippe Tulliez

Bonjour,

Citation:

le problème c'est que la date change à chaque fois et je ne veux pas l'écrire à la main dans la cellule

Vous ne voulez pas l'écrire à la main ?
Et avec un InputBox que faites vous, si ce n'est un encodage manuel ?

Ma réponse n'est jamais qu'un exemple à adapter.
05/10/2023, 13h43
lourid

[QUOTE=Philippe Tulliez;11976049]Bonjour,

Oui, j'ai besoin d'une (inputbox) dans laquelle je peux insérer la date pour qu'elles recherchent dans la colonne P de la feuille source
05/10/2023, 14h10
Philippe Tulliez

Bonjour,
Je vous ai donné toute la phase de filtrage, copie et suppression des données avec un exemple où la date se trouvait dans une cellule, il vous restait à l'adapter pour le faire avec un Input.
Il faut donc juste remplacer la ligne 15 du code que j'ai publié par cette instruction

Code:

myDate = CDate(InputBox("Entrez une date"))

et ajouter en fin de procédure, une instruction que j'ai oubliée la suppression du filtre entre la ligne 26 et 27 toujours du code publié soit

Code:

shtSource.ShowAllData ' Réaffiche les données
05/10/2023, 15h26
lourid

1 pièce(s) jointe(s)

ça me donne une erreur
05/10/2023, 15h52
Franc

Tu dois remplacer Field:=9 par Field:=16, qui correspond à la colonne P de ta feuille "Ratei" et la macro fonctionnera parfaitement!
A part ça, "ça me donne une erreur" ça ne veut pas dire grand-chose.
05/10/2023, 16h30
lourid

1 pièce(s) jointe(s)

bien sûr philippe mais je ne sais pas comment formuler la question...:D..même en mettant 16 blocs la macro
où est-ce que je me trompe ?
05/10/2023, 19h12
Philippe Tulliez

Bonjour,
Avez-vous essayé d'utiliser l'enregistreur de macro sur vos propres données en faisant un simple filtre sur les dates pour savoir quel numéro de colonne il propose et surtout voir si le filtre se réalise correctement.
Et comme l'a écrit Franc, que je salue, indiquer qu'il y a une erreur n'apporte aucune information intéressant. Lorsque le VBA signale une erreur, il y a toujours un numéro d'erreur ET un texte qui indique ce que c'est comme erreur et ça cela peut nous aider.
11/10/2023, 14h16
lourid

2 pièce(s) jointe(s)

Bonjour a tous
J'ai éliminé l'erreur précédente et maintenant j'ai le bloc ici
11/10/2023, 15h49
Philippe Tulliez

Bonjour,
Il y a de fortes chances qu'il n'y ait aucune cellule visible.
Peut-être la manière dont vos données sont encodées ?
Avez-vous essayé manuellement, sans code VBA, de faire la même chose pour voir si vous avez un résultat probant soit des lignes filtrées ?
11/10/2023, 17h48
Franc

Bonjour, j'ai repris ton fichier example.xlsm avec la macro que tu fais tourner et je comprends maintenant pourquoi ça ne fonctionne pas.
Tu as recopié la macro de Philippe et adapté à ta sauce sans tenir compte des informations que Philippe t'a données.
Tu as écrit:

myDate = shtSource.Range("01/09/2023").Value, ça ne marche pas car range attend un nom de cellule et pas une date.
Tu aurais pu écrire myDate = shtSource.Range("AO2").Value par exemple.
Si tu veux un inputbox, Philippe t'a proposé myDate = CDate(InputBox("Entrez une date"))

Set oRange = shtSource.Range("AO2").CurrentRegion n'est pas correct car AO2 est une cellule en dehors de la zone à filtrer.
Dans le cas de ton tableau il faut utiliser:
Set oRange = shtSource.Range("A1").CurrentRegion

Je t'avais précisé d'utiliser Field:=16 et pas Field:=9, et enfin, Philippe avait ajouté shtSource.ShowAllData en fin de macro, ce que je ne vois pas dans la tienne.

C'est bien la peine de faire comme Ducros (se décarcasser) si après tu fais les choses à ta mode.
J'ai testé la macro de Philippe avec ton fichier, et ça fonctionne!!!
12/10/2023, 09h01
lourid

1 pièce(s) jointe(s)

Bonjour,
oui, j'ai essayé manuellement et cela fonctionne, mais comme vous pouvez le voir, le filtre fonctionne mais il est alors incapable de copier le range de cellules dans la feuille Cex
12/10/2023, 10h00
Philippe Tulliez

Bonjour,
Dans l'image que vous avez publiée, je crois voir Selection.AutoFilter or dans mon code, j'ai utilisé une variable objet oRange qui représente la plage à filtrer et pas l'objet Selection
Si vous modifiez sans arrêt ce que l'on vous propose, débrouillez vous tout seul. Je n'ai pas de temps à perdre.
13/10/2023, 13h18
lourid

1 pièce(s) jointe(s)

Je ne vois pas ce que tu veux dire, qu'est-ce que j'aurais dû changer ? Je ne comprends pas, tu es l'expert
J'ai essayé d'ajouter uniquement "Selection,Autofilter" si je le supprime, cela me donne l'erreur habituelle
13/10/2023, 14h02
Franc

Envoie le classeur avec la macro que tu utilises.
16/10/2023, 14h27
lourid

1 pièce(s) jointe(s)

bonjor
J'envoie le fichier avec la macro que j'utilise

Comme je le pensais, tu n'as pas tenu compte des réponses qui t'ont été données.

- tu as écrit Set oRange = shtSource.Range("AO2").CurrentRegion alors que c'est shtSource.Range("A1").
- tu as ajouté un Selection.AutoFilter qui n'a rien à faire là.
- tu as écrit shtSource.ShowAllData après la ligne Set shtSource = Nothing, donc ça ne peut pas fonctionner.

J'ai testé et tout fonctionne sans la moindre erreur. Efface la macro de ton classeur et remplace par celle-ci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub t()
 
  ' Déclaration des variables et constante
  Const SheetSource As String = "Ratei" ' Nom de la feuille source
  Const SheetTarget As String = "cex"  ' Nom de la feuille cible
  Dim shtSource As Worksheet
  Dim shtTarget As Worksheet
  Dim oRange As Range                    ' Plage source
  Dim oRangeFiltered As Range            ' Plage source filtrée
  Dim myDate As Long
 
  ' Affectation des variables
  With ThisWorkbook
   Set shtSource = .Worksheets(SheetSource)
   Set shtTarget = .Worksheets(SheetTarget)
  End With
 
  myDate = CDate(InputBox("mettere una data"))
  Set oRange = shtSource.Range("A1").CurrentRegion
 
  ' Début
  With oRange
  .AutoFilter Field:=16, Criteria1:="<" & myDate
   ' Définit la plage filtrée avec la ligne des titres
   Set oRangeFiltered = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
   oRangeFiltered.Copy Destination:=shtTarget.Range("A1") ' Copie des données
   ' Définit la plage filtrée sans la ligne des titres
   Set oRangeFiltered = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
   oRangeFiltered.EntireRow.Delete                        ' Suppression des données
  End With
  shtSource.ShowAllData
  Set oRange = Nothing: Set oRangeFiltered = Nothing: Set shtSource = Nothing: Set shtTarget = Nothing
 
End Sub

Pour info, si tu modifies la macro et que tu crées de nouveaux problèmes, moi je n'interviens plus dans cette discussion!

16/10/2023, 17h08
lourid

Salut Franc
oui, merci beaucoup, c'est très bien