从数组中提取变量

时间:2013-10-03 10:54:33

标签: excel vba excel-vba

如何使用来自col S ...的每个单元格的值提供变量“CatchPhrase”? 我需要在col S中选择包含每个单元格值的所有行。

问题是col S有1996个不同的数字,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

2 个答案:

答案 0 :(得分:1)

使用与Is it possible to fill an array with row numbers which match a certain criteria without looping?

相同的方法

您可以返回column A(我在此示例中使用A1:A200)中与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

答案 1 :(得分: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