Travail sur tableau virtuel

Bonjour le forum

J'ai besoin de vos lumières

J’essaye d'optimiser mon code d'extraction, aujourd'hui ma technique d'extraction est que quand je remplis une condition alors j'extraie la ligne vers un autre fichier. Maintenant je souhaiterais travailler via un tableau virtuel pour gagner en temps de traitement.

J'ai essayé de me documenté mais sans trouver ce qui me correspond

Ce que je veux faire :

L'utilisateur sélectionne une plage, cette plage (un .range()) devient donc un tableau (TabBD = .range().Value), dans ce tableau si une condition est respectée alors la ligne est préservée, sinon non.

J'espère avoir été clair , vous retrouverez le bout du code concerné, si besoins je peux partager le fichier complet.

Par avance, merci de l’intérêt porté au sujet

temp = 0
cpt = 0
For i = LBound(TabBD, 1) To UBound(TabBD, 1)
    For j = LBound(TabBD, 2) To UBound(TabBD, 2)
        If UCase(TabBD(i, j)) Like "*" & UCase(LaRecherche) & "*" Then
            If i = temp Then Exit For
            cpt = cpt + 1
            'Ligne TabBD gardée / préservée
            temp = i
        End If
    Next j
Next i

Bonjour GGautier,

la valeur que tu cherches est dans une colonne bien précise ou elle est placé aléatoirement dans une colonne ?

Peux tu transmettre ton fichier de travail ?

Non elle peut être dans n'importe quelle colonne !

Bonjour,

Encore un adepte du saucisson ? Avec juste la peau difficile de te dire s'il est bon !

[EDIT] Merci d'avoir joint le fichier entre temps.

A+

Je pense que tu es en train d'essayer de réinventer la roue :

Un tableau virtuel (Array) ne se parcourt pas avec un For... each ni avec Find mais avec un :

For i = 1 to NombreDeLignes
For k = 1 to NombreDeColonnes
If Tablo(i,k) = "blabla" Then StockageDansUneStructureDeMémorisation.
Next
Next

Bien que cette double boucle oblige à parcourir un grand nombre de valeur, cette manière de faire est très rapide car le Tablo source n'embarque aucune autre propriétés (formules, formats...) qui rendent l'exploration des feuilles Excel très chronovore.

A+

C'est effectivement ce que je fait :

temp = 0
cpt = 0
For i = LBound(TabBD, 1) To UBound(TabBD, 1)
    For j = LBound(TabBD, 2) To UBound(TabBD, 2)
        If UCase(TabBD(i, j)) Like "*" & UCase(LaRecherche) & "*" Then
            If i = temp Then Exit For
            cpt = cpt + 1
            'Ligne TabBD gardée / préservée
            temp = i
        End If
    Next j
Next i

Ce qu'il me manque c'est comment stocké une ligne du tableau si elle correspond bien à mon critère ????

Voici un essai:

Sub Test()
    Dim Temp&, cpt&
    Dim NewTab

    For i = LBound(TabBd, 1) To UBound(TabBd, 1)
        For j = LBound(TabBd, 2) To UBound(TabBd, 2)
            If UCase(TabBd(i, j)) Like "*" & UCase(LaRecherche) & "*" Then
                cpt = cpt + 1
                ReDim Preserve NewTab(cpt - 1, UBound(TabBd, 2))
                For x = LBound(TabBd, 2) To UBound(TabBd, 2)
                    NewTab(cpt - 1, x) = TabBd(i, x)
                Next j
            End If
        Next j
    Next i
End Sub

Ton fichier est trop abstrait déconnecté de ta macro...

Produire un fichier de départ dans une feuille

Exprimer la recherche (Est-ce un mot ou seulement un caractère isolé ou non)

Si la recherche à pour but de modifier la feuille source le préciser et montrer dans une autre feuille le résultat attendu dans la feuille source.

Si la recherche à pour but de produire une extraction de la feuille source dans une autre feuille, le préciser.

A+

j'ai un soucis sur cette ligne : ReDim Preserve

Le soucis peux venir si tu as indiquer "Option Base 1" au début de ta procédure, sinon je ne vois pas pourquoi il y aurait une erreur.

Quel type d'erreur a tu ?

non ma première colonne commence bien à zéro !!

J'ai un problème d'incompatibilité de type a partir du moment ou cpt = 1 sur la ligne Redim Preserve

Le code fonctionne bien à la première incrémentation (quand cpt=0)

Dim NewTab()
Dim x
'Temp = 0
cpt = 0

For i = LBound(TabBD, 1) To UBound(TabBD, 1)
    For j = LBound(TabBD, 2) To UBound(TabBD, 2)
        If UCase(TabBD(i, j)) Like "*" & UCase(LaRecherche) & "*" Then
            cpt = cpt + 1
            ReDim Preserve NewTab(cpt - 1, UBound(TabBD, 2))
            For x = LBound(TabBD, 2) To UBound(TabBD, 2)
                NewTab(cpt - 1, x) = TabBD(i, x)
            Next x
        End If
    Next j
Next i
FeuilExt.Range("A2").Resize(, UBound(NewTab, 2)).Value2 = NewTab

Ah oui pardon, erreur de ma part, voici une correction

Dim NewTab()
Dim x
'Temp = 0
cpt = 0

For i = LBound(TabBD, 1) To UBound(TabBD, 1)
    For j = LBound(TabBD, 2) To UBound(TabBD, 2)
        If UCase(TabBD(i, j)) Like "*" & UCase(LaRecherche) & "*" Then
            cpt = cpt + 1
            ReDim Preserve NewTab( UBound(TabBD, 2),cpt - 1)
            For x = LBound(TabBD, 2) To UBound(TabBD, 2)
                NewTab(x,cpt - 1) = TabBD(i, x)
            Next x
        End If
    Next j
Next i

FeuilExt.Range("A2").Resize(, UBound(NewTab, 2)).Value2 = Application.transpose(NewTab)

Oui ! ça m'a l'air ok, maintenant je galère pour envoyer le NewTab vers ma feuille

Voici la bonne méthode pour coller un array :

FeuilExt.Range("A2").Resize(UBound(NewTab, 1), UBound(NewTab, 2)) = Application.transpose(NewTab)

Oui j'avais déjà repris cette ligne, mais ça ne marche pas (voir image), j'essaye de tourner tout ça dans tous les sens sans comprendre ce qui ne va pas ...

J'ai contrôlé manuellement les données contenues dans NewTbl et c'est ok, c'est vraiment la manière d'envoyer NewTbl sur la feuille qui cloche !

Et comme ceci:

FeuilExt.Range("A2").Resize(UBound(NewTab, 2), UBound(NewTab, 1)) = Application.transpose(NewTab)

Oui c'est bcp mieux !

FeuilExt.Range("A2").Resize(UBound(NewTab, 2) + 1, UBound(NewTab, 1) + 1) = Application.Transpose(NewTab)

Il reste un petit soucis, il y à un décalage, voir image

J'imagine que c'est due au fait qu'il y a un décalage avec la première colonne de NewTab qui est 0

Bonjour,

Je vais peut-être dire une ânerie mais j'ai l'habitude...

De plus avec une boule de cristal on voit parfois des choses étranges ! Comme c'est un tableau virtuel et un classeur virtuel on y voit parfois parfois des ectoplasmes de solutions...

C'est l'inconvénient de travailler sans déclarations : Tu te retrouves comme nous dans une situation bizarre...

Essaie avec :

Option Base 1 en tête de ton module( juste après Option Explicit...)

Ensuite reprend la formule d'origine :

FeuilExt.Range("A2").Resize(UBound(NewTab, 2) , UBound(NewTab, 1)) = Application.Transpose(NewTab)

A+

Merci Galopin et Florian,

Il reste une dernière épreuve à passer

L' extraction fonctionne bien dans la limite où dans le tableau, une donnée n’excède pas 255 caractères. Si c'est le cas j'ai une incompatibilité de type.

J'avais déjà été confronté à ce problème en essayant de transposer un Tableau dans une Liste d'un userform.

J'avais alors utilisé à la place de transpose me.listbox1.column=tbl au lieu de me.listbox.list=application.transpose(tbl)

Comment dans mon cas l'adapter à cette ligne ?

FeuilExt.Range("A2").Resize(UBound(NewTab, 2), UBound(NewTab, 1)) = Application.Transpose(NewTab)