XL 2016 code VBA pour faire une extraction automatique de données selon critères

[lajoie25]

Bonjour.

J'ai un fichier Excel. J'ai une feuille source contenant un ensemble de données.
Je souhaiterais faire une extraction automatique d'une chaîne de données dans mon ensemble de données selon des critères (VBA).

Voir fichier joint.

 

[laurent950]

Bonsoir lajoie25
,
Dans votre feuille excel vous noter ceci :
- Afficher dans cette plage les nombres dont les 3 premiers chiffres commencent par 442 à 449 sauf (446)
- Mais dans votre exemple il y a 441

J'ai donc réalisé le code en excluant (446), et je me suis fié à votre exemple soit : 441 à 449 sauf (446)

VBA : Cocher l'option
- Outils
- References - VBAProject
- Cocher : Microsoft VBScript Regular Expressions 5.5

Sub extraction()

Dim reg As VBScript_RegExp_55.RegExp
Dim Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection

Dim TRes() As Variant
Dim cpt As Long: cpt = 0
ReDim TRes(cpt)

Dim i As Long
    For i = 6 To 185
    ' instanciation
        Set reg = New VBScript_RegExp_55.RegExp
    ' Pattern
        reg.Pattern = "^(44[1-5])|^(44[7-9])"
    ' Code
        Set Matches = reg.Execute(Sheets("Source").Cells(i, 3))
            For Each Match In Matches
                TRes(cpt) = Sheets("Source").Cells(i, 3) 'Match.Value
                cpt = cpt + (i / i)
                ReDim Preserve TRes(cpt)
            Next Match
    Next i
' Resultat
    Sheets("resultat").Cells(8, 2).Resize(UBound(TRes)) = Application.Transpose(TRes)

' Decharge les variables
Set Matches = Nothing
Set Match = Nothing
Set reg = Nothing
Erase TRes
cpt = Empty
i = Empty

End Sub

Laurent

 

[Jacky67]

Bonjour.

J'ai un fichier Excel. J'ai une feuille source contenant un ensemble de données.
Je souhaiterais faire une extraction automatique d'une chaîne de données dans mon ensemble de données selon des critères (VBA).

Voir fichier joint.

Bonsoir à tous
Le code ci-dessous à placer dans le module de la feuille "Resultat"
Ne tient pas compte de "441000"
Sinon modifier
[Tableau2].Offset(, 1).Formula = "=AND(LEFT(c6,3)*1>=441,LEFT(c6,3)*1<=449,LEFT(c6,3)*1<>446)
La mise à jour et faite à la sélection de la feuille "resultat"

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    [Tableau2[DONNEES]].NumberFormat = "General"
    Sheets("Source").Columns(4).Insert
    [Tableau2].AutoFilter
    [Tableau2].Offset(, 1).Formula = "=AND(LEFT(c6,3)*1>=442,LEFT(c6,3)*1<=449,LEFT(c6,3)*1<>446)"
    [Tableau2].AutoFilter Field:=2, Criteria1:="TRUE"
    [Tableau2[DONNEES]].SpecialCells(xlCellTypeVisible).Copy Sheets("resultat").[b8]
    Sheets("Source").Columns(4).Delete
End Sub

 

[laurent950]

Bonjour Jacky67, lajoie25, le Forum.

Jacky67 votre code est aussi vraiment très bien, et cible aussi parfaitement la demande de lajoie25.

Pour ma part j'ai modifié mon pattern avec l'explication ci-dessous .
lajoie25 à demandé : Afficher dans cette plage les nombres dont les 3 premiers chiffres commencent par 442 à 449 sauf 446.

donc substituer le pattern du poste #2 :
- reg.Pattern = "^(44[1-5])|^(44[7-9])"
Par ce nouveau pattern :
- reg.Pattern = "^(4){2}(2|3|4|5|7|8|9)"

soit : toute les séries de nombre qui commence =^et suivie par 44 = (4){2} et suivie d'un chiffre au choix = (2|3|4|5|7|8|9)
exclus : 1 et 6 de la recherche.

Laurent

 

[lajoie25]

Bonjour Jacky67, lajoie25, le Forum.

Jacky67 votre code est aussi vraiment très bien, et cible aussi parfaitement la demande de lajoie25.

Pour ma part j'ai modifié mon pattern avec l'explication ci-dessous .
lajoie25 à demandé : Afficher dans cette plage les nombres dont les 3 premiers chiffres commencent par 442 à 449 sauf 446.

donc substituer le pattern du poste #2 :
- reg.Pattern = "^(44[1-5])|^(44[7-9])"
Par ce nouveau pattern :
- reg.Pattern = "^(4){2}(2|3|4|5|7|8|9)"

soit : toute les séries de nombre qui commence =^et suivie par 44 = (4){2} et suivie d'un chiffre au choix = (2|3|4|5|7|8|9)
exclus : 1 et 6 de la recherche.

Laurent

Laurent950 et Lacky67, merci pour vos apports.