1

変数「CatchPhrase」に列 S の各セルの値を入力するにはどうすればよいですか? 列 S の各セルの値を含むすべての行を選択する必要があります。

問題は、列 S に 1996 の異なる番号があり、列 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

必要なものの例: ここに画像の説明を入力

4

2 に答える 2

1

と同じアプローチを使用して、ループせずに特定の基準に一致する行番号で配列を埋めることは可能ですか?

以下のように、リストに一致するcolumn A（この例で使用した）からの数値の配列を返すことができますA1:A200S1: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

2 番目のサブは、これらのセルを直接選択します。

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
于 2013-10-03T11:25:55.330 に答える
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
于 2013-10-03T11:29:00.117 に答える