VBA字符串搜索循环-返回匹配列表

时间:2018-09-13 12:59:41

标签: excel string vba excel-vba for-loop

这是我的数据:

Data

同一张纸上有多个数据块,F列在某些时候始终具有“ Controller Firmware Version”(控制器固件版本),并且该版本始终位于其下方一个单元格中,而D则包含充电器序列号2。它的左边。

我希望得到的结果是一个列表框,其中列出了所有PK ###及其各自的固件版本:

PK ### LP2.28
PK ### LP#。##
...

Sub Check_Firmware()
    Dim S1$, Firmware As Range, x As Range, ws As Worksheet

    ws = Worksheet(Sheet1)
    Search = "Controller Firmware Version"

    With ws

    Set Firmware = Range("F:F" & Cells(Rows.Count, "F").End(xlUp).Row)
    For Each x In Firmware
        If x.Value2 = "Search" Then
            S1 = S1 & " " & worksheet.function(offset(x.Address(0, 0),1,0)
        End If
    Next

      'How to offset and copy the LP2.28 and compile the results?

End Sub

2 个答案:

答案 0 :(得分:4)

使用Option Explicit。这确实是必须的,它可以帮助您解决每行代码大约1个错误。

这是一个示例:

Option Explicit

Sub TestMe()

    Dim S1 As String, search As String, Firmware As Range
    Dim x As Range, ws As Worksheet

    Set ws = Worksheets("Sheet1")
    search = "Controller Firmware Version"

    With ws
        Set Firmware = .Range("F1:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
        For Each x In Firmware
            If x.Value2 = search Then
                S1 = S1 & " " & x.Offset(1, -2)
                S1 = S1 & " " & x.Offset(1, 0)
                S1 = S1 & vbCrLf
            End If
        Next
    End With

    Debug.Print S1

End Sub

更改:

  • 声明了search变量;
  • Worksheets而不是Worksheet;
  • ..Range("F1:F"...之前添加,因此With ws实际上很有用;
  • Range("F:F")将返回整列。要获取特定数量的单元格,需要.Range("F1:F & numberOfCells).Range("F:F5")将是一个错误;
  • x.Offset()是获取范围对象的相对值所需的函数;
  • 分配工作表对象时,使用单词set-Set ws = Worksheets("Sheet1")
  • 完成

答案 1 :(得分:1)

可以这样做

Option Explicit

Sub Check_Firmware()
    Dim ArrPK() As String, SearchString As String 'Declare ArrPk as string array 
    Dim Firmware As Range, aCell As Range
    Dim ws As Worksheet
    Dim PkCounter As Long
    Dim LstBox As msforms.ListBox

    Set ws = ThisWorkbook.Sheets("Sheet1")        
    SearchString = "Controller Firmware Version"
    Set LstBox = UserForm1.ListBox1

    PkCounter = 1

    With ws
         'set range that will be source for searching 
        Set Firmware = .Range("F1:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)                          


        For Each aCell In Firmware 'loop each cell of desired range 
            If aCell.Value2 = SearchString Then 'if match found 
                ReDim Preserve ArrPK(1 To 2, 1 To PkCounter) 'redimension array.
                ArrPK(1, PkCounter) = aCell.Offset(1, 0) 'firmware
                ArrPK(2, PkCounter) = aCell.Offset(1, -2) 'serial no
                PkCounter = PkCounter + 1 'increase counter for next match found 
            End If
        Next
    End With

    With LstBox
        .Clear
        .ColumnCount = 2
        .Width = 105
        .ColumnWidths = "50;50"
        For PkCounter = LBound(ArrPK(), 2) To UBound(ArrPK(), 2)
            .AddItem 'add new item to listbox 
              'put values to newly added row 
            .List(PkCounter - 1, 0) = ArrPK(1, PkCounter) 'new row/column 0 
            'PkCounter - 1 because listbox is counted from 0 
            .List(PkCounter - 1, 1) = ArrPK(2, PkCounter)'new row/column 1 
        Next PkCounter
    End With

    UserForm1.Show

End Sub


编辑:
ReDim Preserve ArrPK(1 To 2, 1 To PkCounter) 这为数组设置了新尺寸
所以现在您有2个维度数组。

Preserve表示数组中所有已存在的值将保留在那里 1 To 2 and 1 to PkCounter是数组的新尺寸。当您找到更多匹配项时,PkCounter会增加,数组也会增加。

With LstBox上打开一个断点,打开“本地”窗口。您将在此处看到ArrPK数组,并且可以检查其中的内容。
您可以在网上阅读有关阵列的更多信息。