Создание отчета в отдельной вкладке на основе результата сопоставления в другом - PullRequest
0 голосов
/ 09 марта 2020

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

Приведенный ниже код возвращает ошибку несоответствия типов для For i = 4 To UBound(vDB, 1).

Я создал упрощенную версия, к которой вы можете получить доступ, используя ссылку ниже.
https://drive.google.com/open?id=1awHkMyHrh4uirhmo1T1DU10K9ckDCwE7

Вот идея:

  • Когда имя вводится в поле на втором листе совпадающее имя находится в первом столбце первого листа.
  • Информация (название, номер, версия обучения) для незавершенных тренингов (с буквой «N» в строке с соответствующее имя) копируется на вторую вкладку с транспонированным макетом.
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

Я очень плохо знаком с VBA.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...