2013-10-03 63 views
1

如何從Col S中的每個單元格輸入變量「CatchPhrase」? 我需要選擇含有來自在COL每個單元值的所有行S.來自數組的進給變量

問題是,COL■找1996 diferent號碼,和col A具有628790號..的

Sub SelectManyRows() 
Dim CatchPhrase As String 
Dim WholeRange As String 
Dim AnyCell As Object 
Dim RowsToSelect As String 

CatchPhrase = "10044" 

'first undo any current highlighting 
Selection.SpecialCells(xlCellTypeLastCell).Select 
WholeRange = "A1:" & ActiveCell.Address 
Range(WholeRange).Select 
On Error Resume Next ' ignore errors 

For Each AnyCell In Selection 
If InStr(UCase$(AnyCell.Text), UCase$(CatchPhrase)) Then 
    If RowsToSelect <> "" Then 
     RowsToSelect = RowsToSelect & "," ' add group separator 
    End If 
    RowsToSelect = RowsToSelect & Trim$(Str$(AnyCell.Row)) & ":" & Trim$(Str$(AnyCell.Row)) 
End If 
Next 

On Error GoTo 0 ' clear error 'trap' 
Range(RowsToSelect).Select 
End Sub 

例我需要: enter image description here

回答

1

使用相同的方法爲Is it possible to fill an array with row numbers which match a certain criteria without looping?

您可以從column A返回的數字陣列(我用在這個例子中)在S1:S9匹配列表如下

Sub GetEm() 
Dim x 
x = Filter(Application.Transpose(Application.Evaluate("=if(NOT(ISERROR(MATCH(A1:A200,$S$1:S9,0))),a1:a200,""x"")")), "x", False) 
End Sub 

第二子,做這些細胞

Sub GetEm2() 
Dim x1 
x1 = Join(Filter(Application.Transpose(Application.Evaluate("=if(NOT(ISERROR(MATCH(A1:A200,$S$1:S9,0))),""a""&row(a1:a200),""x"")")), "x", False), ",") 
Application.Goto Range(x1) 
End Sub 
+0

稀釋我真的不程序員..你可以請發佈完整的腳本..我嘗試實施你的解決方案...但沒有運氣..提前感謝' –

+0

這是完整的腳本:)什麼不適合你 – brettdj

+0

我把你的代碼粘貼到VB中,當我啓動它時,彈出的窗口要求我運行宏。比我必須選擇運行.. :-(Sheet2.GemEm或Shee2.GemEm2 ..我應該怎麼做...? –

0

的直接選擇考慮:

Sub dural() 
    Dim rS As Range, wf As WorksheetFunction 
    Dim N As Long, aryS As Variant, rSelect As Range 
    Dim i As Long, v As Variant 
    ' 
    '  Make an array from column S 
    ' 
    N = Cells(Rows.Count, "S").End(xlUp).Row 
    Set wf = Application.WorksheetFunction 
    Set rS = Range("S1:S" & N) 
    aryS = wf.Transpose(rS) 
    ' 
    '  Loop down column A looking for matches 
    ' 
    Set rSelect = Nothing 
    N = Cells(Rows.Count, "A").End(xlUp).Row 
    For i = 1 To N 
     v = Cells(i, 1).Value 
     If v = Filter(aryS, v)(0) Then 
      If rSelect Is Nothing Then 
       Set rSelect = Cells(i, 1) 
      Else 
       Set rSelect = Union(Cells(i, 1), rSelect) 
      End If 
     End If 
    Next i 
    ' 
    '  Select matching parts of column A 
    ' 
    rSelect.Select 
End Sub