Блог

У меня есть два листа

1. Источник (ThisWorkbook) — содержит несколько листов
2. Назначение (WBD) — содержит 1 лист

Это процесс:

1. Сравните каждую ячейку из диапазона в WBD (B2: B6) со всеми именами листов в этой рабочей книге
2. Если найдено совпадение, выберите диапазон в WBD (C2: C7) и найдите его на соответствующем листе
3. (вот тут у меня проблемы) Как мне получить значение ячейки средней цены? Нужен ли мне еще один цикл?

* расстояние между типом и ценой соответствует.

Вот что я получил до сих пор:

 For Each cel In WBD.Worksheets(1).Range("B2:B6")
    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
            If ws.Name = cel.Value Then
                'find C2:C7 , offset, copy avg price, paste
    Next ws
Next cel
 

Источник — ThisWorkbook

Назначение — WBD

Поиск по листам

Подход Application.Match

 Option Explicit

Sub lookupValues()

    Const dFirst As Long = 2
    Const sFirst As Long = 2
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    'Dim WBD As Workbook: Set WBD = ThisWorkbook
    
    Dim drg As Range
    Dim dLast As Long
    With WBD.Worksheets(1)
        dLast = .Cells(.Rows.Count, "C").End(xlUp).Row ' because merged in 'B'
        Set drg = .Cells(dFirst, "B").Resize(dLast - dFirst   1)
    End With
    
    Dim src As Worksheet
    Dim srg As Range
    Dim cel As Range
    Dim dMatch As Variant
    Dim sMatch As Variant
    Dim sLast As Long
    
    For Each src In swb.Worksheets
        sLast = src.Cells(src.Rows.Count, "C").End(xlUp).Row
        Set srg = Nothing
        On Error Resume Next
        Set srg = src.Cells(sFirst, "B").Resize(sLast - sFirst   1)
        On Error GoTo 0
        If Not srg Is Nothing Then
            dMatch = Application.Match(src.Name, drg, 0)
            If IsNumeric(dMatch) Then
                Set cel = drg.Cells(dMatch)
                Do
                    sMatch = Application.Match(cel.Offset(, 1).Value, srg, 0)
                    If IsNumeric(sMatch) Then
                        cel.Offset(, 2).Value _
                            = srg.Cells(sMatch).Offset(3, 2).Value
                    End If
                    Set cel = cel.Offset(, 1).Offset(1, -1) ' because merged
                Loop Until Len(cel.Value) > 0 Or cel.Row > dLast
            End If
        End If
    Next src
    
    'WBD.Save
    'swb.Close SaveChanges:=False
    
End Sub
 

 Sub m1()
    For Each cel In ThisWorkbook.Worksheets(1).Range("B2:B6")
        If cel.MergeCells Then  
            shname = cel.MergeArea.Cells(1, 1).Value    ' if cells merged, only first cell contains value
        Else
            shname = cel.Value
        End If
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name = shname Then
                Set f = ws.Columns("B").Find(cel.Offset(0, 1).Value, lookat:=xlWhole)
                If Not f Is Nothing Then ' its found
                    Set f = ws.Cells.Find("avg price", after:=f.Offset(0, 1))
                    If Not f Is Nothing Then ' its found
                        cel.Offset(0, 2).Value = f.Offset(0, 1).Value
                    End If
                End If
            End If
        Next ws
    Next cel
End Sub