来自ubound数组范围的Instr

时间:2014-05-05 11:15:41

标签: arrays excel vba search excel-vba

对于一列中的搜索(B列),我使用此代码

Private Sub TextBox1_Change()

txt = TextBox1.Text
lt = Len(TextBox1.Text)
If lt = 0 Then Exit Sub

x = Range("b1", Cells(Rows.Count, 1).End(xlUp)).Value

For i = 1 To UBound(x, 1)
    If InStr(x(i, 2), txt) Then
            s = s & "~" & x(i, 1) & "         >>>>" & x(i, 2)

    Else
    End If
Next i

ListBox1.List = Split(Mid(s, 2), "~")
End Sub

但是如何更改此代码以在一些列(B列和A列)或(B列和A列和C列)中同时查找txt?

所以,如果我有

in column A 
first
second
thirdFirst

in column B
notfirst
secondFirst
third

使用此代码我只在B列中查看并获取

if txt= first
result
first notfirst
second secondFirst

但我无法从A列找到thirdFist值  所以我需要得到像

这样的结果
if txt= first
result
first notfirst
second secondFirst
thirdFirst third

1 个答案:

答案 0 :(得分:1)

好的,所以我希望我能理解你的问题。这里是代码示例和图片上样本数据的结果。 HTH。

Option Explicit

Private Sub CommandButton1_Click()
    Dim txt, values, valuesFiltered, r, c, rowsCount, columnsCount, check

    txt = "first"
    If Len(txt) = 0 Then _
        Exit Sub

    ' get all values from last used cell in column 'A' to upperRightCell
    ' e.g. "B1', 'C1' etc.
    Dim lastUsedCellInColumn_A As Range
    Set lastUsedCellInColumn_A = Cells(Rows.Count, 1).End(xlUp)

    Dim upperRightCell As Range
    Set upperRightCell = Range("C1")

    values = Range(lastUsedCellInColumn_A, upperRightCell).Value
    rowsCount = UBound(values, 1)
    columnsCount = UBound(values, 2)

    If columnsCount <= 1 Then _
        Err.Raise 12345, , "At least two columns must be used."

    For r = 1 To rowsCount
        For c = 1 To columnsCount

            If InStr(values(r, c), txt) = 0 Then _
                GoTo next_column

            If c > 1 Then
                ' columns B, C, D and so on: take value from neighbour cell on the left
                check = values(r, c) & ">>>>" & values(r, c - 1)
            Else
                ' column A: take value from neighbour cell on the right
                check = values(r, c + 1) & ">>>>" & values(r, c)
            End If

            ' do not add duplicate values
            If IsArray(valuesFiltered) = False Then
                ReDim valuesFiltered(0)
                valuesFiltered(0) = check
            Else
                If UBound(Filter(valuesFiltered, check)) = -1 Then
                    ReDim Preserve valuesFiltered(UBound(valuesFiltered) + 1)
                    valuesFiltered(UBound(valuesFiltered)) = check
                End If
            End If

next_column:
        Next c
    Next r

    If Not IsEmpty(valuesFiltered) Then _
        ListBox1.List = valuesFiltered
End Sub

enter image description here