Таблица поиска в другой книге на соответствие критериям - наиболее эффективный способ

Question

У меня есть таблица с 66 столбцами (представляющими ветряные турбины) и около 5000 строк временных меток. Я должен проверить, соответствует ли значение каждой ячейки, в данном случае скорости, определенным критериям, если это так, я извлекаю название Ветровой турбины из самого верхнего ряда. Используя имя, мне нужно «найти» ближайшую к нему ветряную турбину из матрицы на другом листе и вернуть ее.

    Option Explicit

    Public Sub ErsetzenNachbar()

    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim Arr As Variant
    Dim Rng As Range
    Dim SheetName As String
    Dim i As Long
    Dim j As Long
    Dim WeaMat As Workbook
    Dim Mat As Range
    Dim Arr2 As Variant
    Dim target As Long
    Dim MOfound As String

    SheetName = "INPUT_WIND"

    'Range in the first Workbook
    Set Rng = wb.Worksheets(SheetName).Range("C2:AG5000")

    'Open the second Workbook
    Set WeaMat = Workbooks.Open("C:\Users\Nikhil.srivatsa\Desktop\WeaMat")

    'Set range for second workbook with the Matrix
    Set Mat = WeaMat.Worksheets(1).Range("A2:AP68")

    'Range into array
    Arr = Rng.Value

    'loop through array
    For i = LBound(Arr, 1) To UBound(Arr, 1)

       For j = LBound(Arr, 2) To UBound(Arr, 2)

          If Arr(i, j) = 0.047 Then

         'wind turbine Name from the topmost row
          Arr(LBound(Arr, 1), j) = target

          'look for target in the Matrix and fetch the neighboring turbine here is where i need help!

          End If

       Next j

    Next i


 End Sub

Например, я ищу ячейки, содержащие 0,047 (могут отличаться) и получить "MO30" название турбины. Теперь я смотрю MO30 в Матрице второй рабочей книги и прошу его выбрать MO42 из Матрицы, поскольку это первая ближайшая ветряная турбина.

поможет ли в этом случае Collections или Dictionary? или я должен создать массив из матрицы? или используйте функцию Find?

Answer 1

Вот простой пример с использованием двух листов, а не двух рабочих книг, но посмотрите, сможете ли вы адаптировать его для вашей установки.

Sub x()

Dim rFind1 As Range, s As String, rFind2 As Range

With Sheet1.Range("A1").CurrentRegion
    Set rFind1 = .Find(what:=0.047, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'look for value on sheet1
    If Not rFind1 Is Nothing Then
        s = .Rows(1).Cells(rFind1.Column)  'if found, find corresponding row 1 value
        Set rFind2 = Sheet2.columns(1).Find(what:=s)  'look for this in sheet2
        If Not rFind2 Is Nothing Then MsgBox rFind2.Offset(, 1) 'report contents of cell to the right
    End If
End With

End Sub

Лист1

Лист2

Answer 2

Попробуйте этот код, пожалуйста:

Sub findTurb()
    Dim sh As Worksheet, sh2 As Worksheet, rng As Range, strTurb As String
     Const timeSt As Double = 0.047
    Set sh = ActiveSheet           'use here your sheet
    Set sh2 = Worksheets("second") 'use here your sheet
    Set rng = sh.UsedRange.Find(timeSt)
    If Not rng Is Nothing Then
       strTurb = sh.Cells(1, rng.Column).value
       Set rng = sh2.Range("A1:A" & sh2.Range("A" & Cells.Rows.Count).End(xlUp).Row).Find(strTurb)
       If Not rng Is Nothing Then
           MsgBox rng.Offset(, 1).value
       End If
   End If
End Sub

Он может быть преобразован в функцию, получая метку времени в качестве параметра и возвращая строку ...