Вот мои данные:

Data

На одном листе есть блоки данных, столбец F всегда будет иметь "Версия прошивки контроллера" в какой-то момент, а версия всегда будет на одну ячейку ниже, а также D, содержащий серийный номер зарядного устройства два слева от него ,

Мой желаемый результат - это список, в котором собраны все PK ### с соответствующими версиями прошивки:

ПК ### LP2.28
ПК ### 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
1
AKow 13 Сен 2018 в 15:59

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) Это устанавливает новые размеры для массива
Итак, теперь у вас есть 2-мерный массив.

Preserve означает, что все значения, которые уже есть в массиве, останутся там 1 To 2 and 1 to PkCounter - новые измерения для массива. Когда вы найдете больше совпадений, PkCounter будет расти, как и массив.

Установите точку останова на With LstBox открытое окно "Локальные". Вы увидите там свой массив ArrPK и сможете проверить, что внутри него.
Вы можете узнать больше о массивах в Интернете.

1
Sphinx 13 Сен 2018 в 14:09

Используйте 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")
4
Vityata 13 Сен 2018 в 13:17