2008-11-11 67 views
5

讓我們說我有一個excel電子表格如下圖所示:如何在不使用循環的情況下返回VBA中的單元格範圍?

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

我想根據任一「狗返回單元格區域(DOG1,DOG2,dog3,dog4)或(CAT1,CAT2,CAT3) 「或」cat「

我知道我可以做一個循環來逐個檢查,但是在VBA中是否有其他方法,所以我可以」一次過濾「結果?

也許Range.Find(XXX)可以幫助,但我只看到一個單元格的例子,而不是單元格範圍。

請指點

問候

+0

您發佈的示例看起來很奇怪,請更改它以使其可讀。 – schnaader 2008-11-11 19:36:09

+0

這不是空格鍵問題。他使用了一個奇怪的字符集或其他東西。 – 2008-11-11 19:41:22

回答

0

感謝DJ。

FindAll解決方案仍然使用VBA循環來完成任務。

我試圖找到一種方法,而無需使用用戶級別循環來過濾excel VBA中的範圍。

這裏我找到了一個解決方案。它利用優秀的內置引擎來完成這項工作。

(1)使用 worksheetfunction.CountIf( 「貓」),以獲得 「貓」 細胞計數

(2)使用.Find( 「貓」),以獲得「貓的第一行「

與行數和第一行,我可以得到」貓「範圍已經。

這個解決方案的好處是:沒有用戶級循環,如果範圍很大,這可能會提高性能。

0

Excel支持ODBC協議。我知道您可以從Access數據庫連接到Excel電子表格並進行查詢。我沒有這樣做,但也許有一種方法可以從Excel內部使用ODBC查詢電子表格。

0

除非您使用veeeery舊機器,或者您的XL2007工作表中有一個bazillion行,否則循環將會足夠快。誠實!

不要相信我嗎?看這個。我用這個充滿隨機字母一百萬行範圍:

=CHAR(RANDBETWEEN(65,90)) 

然後我寫了這個功能,並使用名爲它從一個26單元格範圍控制移輸入:

=TRANSPOSE(UniqueChars(A1:A1000000)) 

這裏的不是非常優化的VBA函數我在一兩分鐘從黑客:

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 

在我十歲的Core 2 Duo T7300(2GHz的)筆記本電腦花了0.58秒。

1

忘記了另一個XL2007功能:高級過濾。如果你想在VBA中,我得到這個從錄製的宏:

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

我計時它在約0.35秒......

誠然,沒有多大用處,如果你沒有2007年

2

以下是有關使用記錄集返回範圍的注意事項。

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 
相關問題