从范围中获取特定值并将其存储在另一个范围内

时间:2015-01-21 23:53:33

标签: excel vba excel-vba

我正在尝试输入搜索字词并查看整个特定范围,每次此字词匹配时,信息都会存储在另一列中。

当我使用“Do”,“With”或“While”时,它只存储一个结果。

Sub MethodFindAllSamples()
    Dim rng1 As Range
    Dim strSearch As String
    index = 11
    strSearch = InputBox("Type the model you are looking for, please: ")
    Set rng1 = Range("G:G").Find(strSearch, , xlValues, xlPart, xlByRows, False)
    If Not rng1 Is Nothing Then
        Application.Goto rng1
        Model = ActiveCell(1.1)
        Content = ActiveCell(1, 4)
        FIssues = Range("ER" & ActiveCell.Row + 1).Value
        TIssues = Range("ER" & ActiveCell.Row + 1).Value
        MsgBox "Model selected: " & Model & vbNewLine & "CS: " & Content & vbNewLine & " Issues found: " & FIssues
        Errors = Left(FIssues, 1)
        Errors2 = Mid(TIssues, 22, 1)
        Cells(index, 1).Value = Mid(Model, 4, 6)
        Cells(index, 3).Value = Errors
        Cells(index, 4).Value = Errors2
        Cells(index, 2).Value = strSearch + Left(Content, 8)
    Else
        MsgBox strSearch & " This device can't be found, please try again"
    End If
End Sub

1 个答案:

答案 0 :(得分:0)

这是一个如何实现这个的例子

    Sub MethodFindAllSamples()
    Dim oCell As Range, i&, z&, strSearch$
    strSearch = InputBox("Type the model you are looking for, please: ")
    i = Cells(Rows.Count, "G").End(xlUp).Row
    z = 0
    If strSearch <> "" Then
        For Each oCell In Range("G1:G" & i)
            If Replace(Trim(UCase(oCell.Value)), " ", "") Like "*" & Replace(Trim(UCase(strSearch)), " ", "") & "*" Then
                z = z + 1
            End If
        Next
        If z > 0 Then
            MsgBox "Range [D] contain: " & z & " iteration of the selected model : " & strSearch
        Else
            MsgBox "Range [D] does not contain: " & strSearch
        End If
    Else
        MsgBox "Search model not specified!"
    End If
End Sub