Làm thế nào để trả về một dải ô trong VBA mà không cần sử dụng vòng lặp?

Question

giả sử tôi có một lan rộng tấm excel như dưới đây:

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

Tôi muốn quay trở lại một loạt các tế bào (dog1, dog2, dog3, dog4) hoặc (cat1, cat2, CAT3) dựa trên một trong hai "con chó "hoặc" cat "

Tôi biết tôi có thể làm một vòng lặp để kiểm tra từng cái một, nhưng có phương pháp nào khác trong VBA để tôi có thể" lọc "kết quả trong một lần không?

có thể là Range.Find (XXX) có thể trợ giúp, nhưng tôi chỉ xem các ví dụ cho một ô không phải là một dải ô.

Xin tư vấn

Trân

Answer 1

anh chàng này có một chức năng FindAll đẹp:

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

Answer 2

Cảm ơn DJ.

Giải pháp FindAll đó vẫn sử dụng vòng lặp VBA để làm việc.

Tôi đang cố gắng tìm cách mà không sử dụng vòng lặp cấp người dùng để lọc phạm vi trong VBA excel.

Ở đây tôi đã tìm thấy giải pháp. nó tận dụng lợi thế của động cơ tích hợp sẵn để thực hiện công việc.

(1) sử dụng worksheetfunction.CountIf ("Cát") để có được số lượng của các tế bào "mèo"

(2) sử dụng .find ("mèo") để lấy hàng đầu tiên của "mèo "

với tổng số hàng và hàng đầu tiên, tôi có thể nhận được dải" mèo ".

Phần tốt nhất của giải pháp này là: không có vòng lặp cấp người dùng, điều này có thể cải thiện hiệu suất nếu phạm vi lớn.

Answer 3

Excel hỗ trợ giao thức ODBC. Tôi biết rằng bạn có thể kết nối với một bảng tính Excel từ cơ sở dữ liệu Access và truy vấn nó. Tôi đã không làm điều đó, nhưng có lẽ có một cách để truy vấn bảng tính bằng cách sử dụng ODBC từ bên trong Excel.

Answer 4

Trừ khi bạn đang sử dụng máy cũ, hoặc bạn có một bảng tính XL2007 với hàng tỷ bazillion, một vòng lặp sẽ đủ nhanh. Thật thà!

Đừng tin tôi? Nhìn này. Tôi điền một loạt triệu-hàng với chữ ngẫu nhiên sử dụng này:

=CHAR(RANDBETWEEN(65,90)) 

Sau đó, tôi đã viết chức năng này và gọi nó là từ một phạm vi 26-cell sử dụng Control-Shift-Enter:

=TRANSPOSE(UniqueChars(A1:A1000000)) 

Đây là chức năng VBA không được tối ưu hóa tôi đã hack trong vài phút:

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 

Trên máy tính xách tay Core 2 Duo T7300 (2GHz) cũ của tôi mất 0,58 giây.

Answer 5

Quên một tính năng XL2007 khác: bộ lọc nâng cao.Nếu bạn muốn nó trong VBA, tôi nhận được điều này từ một macro ghi:

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

Tôi hẹn giờ nó vào khoảng 0,35 giây ...

Phải thừa nhận rằng, không phải sử dụng nhiều nếu bạn không phải 2007.

Answer 6

Dưới đây là một số lưu ý về cách sử dụng bản ghi âm để trả về dải ô.

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