Создание отчета в другой вкладке на основе результатов сопоставления

Question

Я очень плохо знаком с VBA и у меня довольно сложная матрица, для которой я пытаюсь создать вкладку поиска. Пожалуйста, помогите!

Я создал упрощенную версию, доступ к которой можно получить по ссылке ниже.

https://drive.google.com/open?id=1awHkMyHrh4uirhmo1T1DU10K9ckDCwE7

Вот идея:

• Когда имя вводится в поле на втором листе, совпадающее имя располагается в первом столбце первого листа.
• Информация (название тренинга, номер, версия) для незавершенных тренингов (те, у которых 'N' в строке с совпадающим названием) копируется на вторую вкладку с транспонированным макетом.

Спасибо!

Answer 1

Попробуйте

Sub test()
    Dim Ws As Worksheet
    Dim toWs As Worksheet
    Dim vDB, vR()
    Dim i As Long, j As Integer
    Dim n As Integer
    Dim sName As String

    Set Ws = Sheets("Sheet1")
    Set toWs = Sheets("Sheet2")

    vDB = Ws.Range("b3").CurrentRegion
    With toWs
        sName = .Range("c2")
        For i = 4 To UBound(vDB, 1)
            If vDB(i, 1) = sName Then
                For j = 3 To 5
                    If vDB(i, j) = "N" Then
                        n = n + 1
                        ReDim Preserve vR(1 To 4, 1 To n)
                        vR(1, n) = vDB(1, j)
                        vR(2, n) = vDB(2, j)
                        vR(3, n) = vDB(3, j)
                        vR(4, n) = vDB(i, j)
                    End If
                Next j
            End If
        Next i
        If n > 0 Then
            With .Range("b4")
                .CurrentRegion.Clear
                .Resize(n, 4) = WorksheetFunction.Transpose(vR)
                With .CurrentRegion
                    .Borders.LineStyle = xlContinuous
                    .CurrentRegion.BorderAround Weight:=xlMedium
                    .HorizontalAlignment = xlCenter
                End With
                .Resize(n, 3).Interior.Color = 14277081
                .Resize(n, 3).BorderAround Weight:=xlMedium
            End With
        Else
            .Range("a4").CurrentRegion.Clear
            MsgBox "No Data"
        End If
    End With

End Sub