Comment retourner une plage de cellules dans VBA sans utiliser de boucle?

Question

disons que j'ai une feuille de calcul Excel comme ci-dessous:

 
col1 col2 
------------ 
dog1 dog 
dog2 dog 
dog3 dog 
dog4 dog 
cat1 cat 
cat2 cat 
cat3 cat 

Je veux retourner une gamme de cellules (dog1, dog2, Dog3, dog4) ou (CAT1, CAT2, CAT3) sur la base de chaque « chien "ou" chat "

Je sais que je peux faire une boucle pour vérifier un par un, mais y a-t-il une autre méthode dans VBA afin que je puisse" filtrer "le résultat en une seule fois? Peut-être que le Range.Find (XXX) peut aider, mais je ne vois que des exemples pour une seule cellule et non une plage de cellules.

S'il vous plaît conseiller

Cordialement

Answer 1

Ce mec a une belle fonction FindAll:

http://www.cpearson.com/excel/findall.aspx

Answer 2

Merci DJ.

Cette solution FindAll utilise toujours une boucle VBA pour faire les choses. J'essaye de trouver un moyen sans utiliser la boucle de niveau d'utilisateur pour filtrer une gamme dans VBA d'Excel.

Ici, j'ai trouvé une solution. il tire parti du moteur intégré Excel pour faire le travail.

(1) utiliser worksheetfunction.CountIf ("Cat") pour obtenir le nombre de cellules "CAT"

(2) utiliser .Find ("cat") pour obtenir la première rangée de « chat "

avec le nombre de lignes et la première rangée, je peux déjà obtenir la gamme" chat ".

La bonne partie de cette solution est: pas de boucle au niveau de l'utilisateur, cela pourrait améliorer les performances si la portée est grande.

Answer 3

Excel prend en charge le protocole ODBC. Je sais que vous pouvez vous connecter à une feuille de calcul Excel à partir d'une base de données Access et l'interroger. Je ne l'ai pas fait, mais il existe peut-être un moyen d'interroger la feuille de calcul en utilisant ODBC à partir d'Excel.

Answer 4

Sauf si vous utilisez une ancienne machine, ou si vous avez une feuille de calcul XL2007 avec un nombre de lignes de bazillion, une boucle va être assez rapide. Honnête!

Ne me fais pas confiance? Regarde ça. Je remplissais une gamme million de lignes avec des lettres aléatoires en utilisant ceci:

=CHAR(RANDBETWEEN(65,90)) 

Ensuite, je l'ai écrit cette fonction et l'a appelé à partir d'une gamme de 26 cellules en utilisant Control-Maj-Entrée:

=TRANSPOSE(UniqueChars(A1:A1000000)) 

Voici la non très optimisé la fonction VBA je piraté en quelques minutes:

Option Explicit 

Public Function UniqueChars(rng As Range) 

Dim dict As New Dictionary 
Dim vals 
Dim row As Long 
Dim started As Single 

    started = Timer 

    vals = rng.Value2 

    For row = LBound(vals, 1) To UBound(vals, 1) 
     If dict.Exists(vals(row, 1)) Then 
     Else 
      dict.Add vals(row, 1), vals(row, 1) 
     End If 
    Next 

    UniqueChars = dict.Items 

    Debug.Print Timer - started 

End Function 

sur mon ans Core 2 Duo T7300 ordinateur portable (2GHz), il a pris 0,58 sec.

Answer 5

Oublié une autre fonctionnalité XL2007: le filtrage avancé.Si vous voulez en VBA, je suis arrivé ce à partir d'une macro enregistrée:

Range("A1:A1000000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= Range("F1"), Unique:=True 

je l'ai chronométré à environ 0,35 sec ...

Il est vrai, pas une grande utilité si vous n'avez pas 2007.

Answer 6

Voici quelques remarques sur l'utilisation d'un jeu d'enregistrements pour renvoyer la plage.

Sub GetRange() 
Dim cn As Object 
Dim rs As Object 
Dim strcn, strFile, strPos1, strPos2 

    Set cn = CreateObject("ADODB.Connection") 
    Set rs = CreateObject("ADODB.Recordset") 

    strFile = ActiveWorkbook.FullName 

    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ 
    & strFile & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';" 

    cn.Open strcn 

    rs.Open "SELECT * FROM [Sheet1$]", cn, 3 'adOpenStatic' 

    rs.Find "Col2='cat'" 
    strPos1 = rs.AbsolutePosition + 1 
    rs.MoveLast 
    If Trim(rs!Col2 & "") <> "cat" Then 
     rs.Find "Col2='cat'", , -1 'adSearchBackward' 
     strPos2 = rs.AbsolutePosition + 1 
    Else 
     strPos2 = rs.AbsolutePosition + 1 
    End If 
    Range("A" & strPos1, "B" & strPos2).Select 
End Sub