VBA---inscription de nombres.

[JJ1]

Bonjour,

Je souhaiterais de votre part un code VBA qui inscrit des nombres:
En plage A:E j'ai des nombres.

Je saisis un nombre en F1, ,la macro développe aussitôt à partir de G2 : Jx tous les nombres dont la ligne contient ce nombre, si je rajoute la saisie d'un deuxième nombre en G1, la macro efface la colonne des nombres déjà inscrits en colonne G et inscrit les nombres en H2:Jx et ainsi de suite.

Si je saisis 4 nombres, il n'y aura qu'un nombre à inscrire en J sur les 5 de la plage.

Je joins un exemple, en onglet 1 un exemple avec un nombre saisi et en onglet 2 ce que cela donnerait avec 2 nombres saisis.

Merci de votre aide.
Bonne soirée

 

[david84]

Re : VBA---inscription de nombres.

Bonjour,
à tester :

Sub test()
Dim pl(), P As Range, Nb As Double, i As Long, j As Byte, k As Long, l As Long, Rep
Dim DerLig As Long
DerLig = Range("A" & Rows.Count).End(xlUp).Row
Nb = Range("F1").Value
For i = 1 To DerLig
Set P = Range(Cells(i, 1), Cells(i, 5))
Rep = Application.Match(Nb, P, 0)
 If Not IsError(Rep) Then
    ReDim Preserve pl(3, l)
        For j = 1 To 5
            If P(1, j) <> Nb Then
                pl(k, l) = P(1, j)
                k = k + 1
            End If
        
        Next j
       k = 0: l = l + 1
End If
Next i
Cells(2, 6).Resize(UBound(pl, 2) + 1, UBound(pl, 2)) = Application.Transpose(pl)
End Sub

A+

 

[job75]

Re : VBA---inscription de nombres.

Bonjour JJ1, salut David 🙂

Cette macro utilise le filtre élaboré :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [G1:J1]
If Target Is Nothing Then Exit Sub
Application.ScreenUpdating = False
[G2:K65536].ClearContents
If Application.Count([G1:J1]) = 0 Then Exit Sub
[F2].Formula = "=AND(IF(N($G$1),COUNTIF($A2:$E2,$G$1),TRUE),IF(N($H$1),COUNTIF($A2:$E2,$H$1),TRUE),IF(N($I$1),COUNTIF($A2:$E2,$I$1),TRUE),IF(N($J$1),COUNTIF($A2:$E2,$J$1),TRUE))"
Range("A1:E" & [A65536].End(xlUp).Row).AdvancedFilter xlFilterCopy, [F1:F2], [G2:K65536]
[F2:K2].ClearContents
Dim cel As Range
For Each cel In [G1:J1]
  [G3:K65536].Replace cel, "#N/A", LookAt:=xlWhole
Next
On Error Resume Next
[G3:K65536].SpecialCells(xlCellTypeConstants, 16).Delete xlToLeft
End Sub

Voir le fichier joint.

Nota : la ligne de titre A1:E1 est indispensable pour le filtre.

A+

 

[JJ1]

Re : VBA---inscription de nombres.

Bonsoir David, Job,

Merci pour vos 2 macros.
Celle de Job correspond plus car il n'y a pas de lancement, l'affichage s'organise en fonction des nombres saisis.
Est-il possible de les décaler pour avoir une suite de 5 avec ceux saisis (et pas juste dessous)
Si je saisis en F1, les 4 nombres commencent en G
je joins un exemple avec 3.

Merci encore
Bonne soirée

 

[david84]

Re : VBA---inscription de nombres.

Re, salut Gérard🙂,

Celle de Job correspond plus car il n'y a pas de lancement, l'affichage s'organise en fonction des nombres saisis

Désolé mais je pensais que depuis le temps, tu savais comment lancer un code à partir d'un évènement de feuille.
Par contre, je me suis aperçu que je n'avais pas traité ta demande dans son intégralité, donc peut-être comme cela.
A+

 

[job75]

Re : VBA---inscription de nombres.

Re,

Pour cadrer à droite sur la colonne K, en fin de macro :

[G3].CurrentRegion.Resize(, Application.Count([G1:J1])).Insert xlToRight

Pour cadrer sur la colonne J :

[G3].CurrentRegion.Resize(, Application.Count([G1:J1]) - 1).Insert xlToRight

Par ailleurs j'ai remplacé "#N/A" par "" => xlCellTypeBlanks, c'est plus simple.

Edit : ben non, j'avais mal testé, il faut conserver "#N/A"...

Fichier (2).

A+

 

[job75]

Re : VBA---inscription de nombres.

Bonjour JJ1, David, le forum,

2 améliorations :

- la macro fonctionne maintenant même si les valeurs ne sont pas des nombres

- la formule du critère entrée en F2 a été simplifiée :

=SOMMEPROD(SIGNE(NB.SI(A2:E2;G$1:J$1))+ESTVIDE(G$1:J$1))=4

Fichier (3).

Edit 1 : s'il y a des doublons sur une même ligne, le cadrage ne se fait pas sur la colonne K.

Il faut alors une boucle sur les lignes filtrées, voir fichier (4).

Edit 2 : ajouté une MFC sur A2:E21 pour visualiser les lignes filtrées, voir fichier (4).

A+

 

[JJ1]

Re : VBA---inscription de nombres.

Bonjour,
Merci David et Job pour vos fichiers, je regarde ce soir.
Merci
Bon AM

 

[david84]

Re : VBA---inscription de nombres.

Salut Gérard🙂,
je vois que fidèle à toi-même tu vas au-delà de la demande initiale pour améliorer la procédure.
J'ai donc modifié ma proposition en tenant compte des possibles doublons et ai rajouté le coloriage des lignes (pas via une MFC mais en l'incluant à la macro).
Par contre pour le texte, je n'ai pas trop compris où tu voulais en venir : est-ce le fait de ne pas prendre en compte le texte rentré en F1:I1 ou en colonne A:E ?
A+

 

[JJ1]

Re : VBA---inscription de nombres.

Re,

Merci David pour ton fichier et le rajout de la MFC qui améliore effectivement la lisibilité.
Par contre le décalage des nombres à droite ne se fait pas.
Merci beaucoup et bonne soirée.
ps: il n'y a aucun doublon (sauf en exemple, pas vu)

 

[david84]

Re : VBA---inscription de nombres.

Re

Par contre le décalage des nombres à droite ne se fait pas

Cela, je ne l'avais pas compris. Alors une très légère modification devrait donner le résultat escompté (si j'ai bien compris cette fois).
A+