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

Question

这是我的数据：

在同一张表上有数据块，F 列在某些时候总是有“控制器固件版本”，版本总是在它下面的一个单元格，以及 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

Answer 1

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

• Option Explicit Reference

这是一个例子：

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") 完成

Answer 2

可以这样做

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)

这为数组设置了新维度
所以现在你有了二维数组。

Preserve 表示所有已经在数组中的值都将保留在那里

1 To 2 and 1 to PkCounter 是数组的新维度。当您找到更多匹配项时，PkCounter 会增长，数组也会增长。

在With LstBox 上设置断点，打开“本地”窗口。您将在那里看到您的 ArrPK 数组，并且您将能够检查其中的内容。

您可以在网上阅读有关数组的更多信息。