¿Cómo devolver un rango de celdas en VBA sin usar un bucle?

Question

digamos que tengo una hoja de cálculo de Excel, como a continuación:

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

quiero devolver un rango de celdas (dog1, dog2, Dog3, Dog4) o (CAT1, CAT2, CAT3) en base a cualquiera de los dos "perro "o" cat "

Sé que puedo hacer un ciclo para verificar uno por uno, pero ¿hay algún otro método en VBA para poder" filtrar "el resultado de una vez?

tal vez la Range.Find (XXX) puede ayudar, pero solo veo ejemplos para una sola celda, no para un rango de celdas.

Por favor, asesoramiento

Saludos

Answer 1

Este tipo tiene una función FindAll agradable:

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

Answer 2

Gracias DJ.

Esa solución FindAll aún utiliza un bucle VBA para hacer cosas.

Estoy tratando de encontrar una forma sin utilizar el bucle de nivel de usuario para filtrar un rango en excel VBA.

Aquí encontré una solución. aprovecha el motor incorporado excel para hacer el trabajo.

(1) utilizar worksheetfunction.CountIf ("gato") para obtener el recuento de las células "gato"

(2) utilizar .find ("gato") para obtener la primera fila de "gato "

con el recuento de filas y la primera fila, ya puedo obtener el rango" cat ".

La buena parte de esta solución es: sin bucle de nivel de usuario, esto podría mejorar el rendimiento si el rango es grande.

Answer 3

Excel admite el protocolo ODBC. Sé que puede conectarse a una hoja de cálculo de Excel desde una base de datos de Access y consultarla. No lo he hecho, pero tal vez haya una forma de consultar la hoja de cálculo usando ODBC desde Excel.

Answer 4

A menos que esté usando una máquina antigua, o tenga una hoja de trabajo XL2007 con un montón de filas, un ciclo será lo suficientemente rápido. ¡Honesto!

¿No confías en mí? Mira este. Llené una gama millones de filas con letras al azar utilizando la siguiente:

=CHAR(RANDBETWEEN(65,90)) 

Entonces escribí esta función y lo llamó desde un rango de 26 células usando Control-Shift-Enter:

=TRANSPOSE(UniqueChars(A1:A1000000)) 

es el Aquí función de VBA Pirateé a cabo en un par de minutos no muy optimizado:

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 

en mi Core años de edad 2 Duo T7300 (2 GHz) portátil que tomó 0,58 segundos.

Answer 5

Olvidé otra característica XL2007: filtrado avanzado.Si quieres que en VBA, tengo esto desde una macro grabada:

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

lo cronometré en alrededor de 0,35 seg ...

Es cierto, no sirve de mucho si no tienen 2007.

Answer 6

Aquí hay algunas notas sobre el uso de un conjunto de registros para devolver el rango.

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