Блог

Мне необходимо автоматически создавать отчет, основанный на датах и портфелях. Например, если я добавлю 2 даты и 2 портфолио, подобные этому

Отчет должен выглядеть следующим образом:

Итак, если мы введем 3 даты и 4 портфеля, в отчете должно быть 3 таблицы, и в каждой из них по 4 портфеля…

Я в порядке, чтобы сделать это вручную, но в идеале это должно быть автоматически (я думаю, что это можно сделать с помощью VBA, но не совсем уверен в этом) можете ли вы, ребята, помочь? Спасибо.

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

Я предполагаю, что дата не влияет на портфолио, не так ли? Если да, то это довольно просто. Я не знаю, как хранятся ваши данные, но давайте предположим, что они равны, как показано на вашем скриншоте.

 Option Base 1 'array will start at 1 instead of 0
Public Setting As Worksheet, ListPortfolios As Worksheet, Project As Worksheet

Public RangeSelectDates As Range, RangeSelectPortfolios As Range, RowOfCodePortfolios As Range
Public ArraySelectDates(), ArraySelectPortfolios(), ArrayOfCodePortfolios(), ArrayPortfolio(), ArrayProject()
Public PortfolioCode$
Dim i%, j%, k%, r%, c%
Sub Automate()


Set Setting = Worksheets("Setting")
Set ListPortfolios = Worksheets("ListPortfolios")
Set Project = Worksheets("Project")

    'First, read the portfolio code and dates to import and store in array
With Setting
    Set RangeSelectDates = .Cells(4, 5).CurrentRegion
    Set RangeSelectPortfolios = .Cells(4, 8).CurrentRegion
End With
ArraySelectDates = RangeSelectDates
ArraySelectPortfolios = RangeSelectPortfolios 'store the range in a Array
ReDim ArrayProject(1 To 24, 1 To 1)
'Now, create an array with the names of the portfolios where you have stored them. I don't know how your data is stored.
'I assume you've got it as the Project sheet result it's shown and also at "ListPortfolios" sheet
With ListPortfolios
    Set RowOfCodePortfolios = .Rows(5)
End With
ArrayOfCodePortfolios = RowOfCodePortfolios 'store the row in a Array
k = 0 'means no value is found
For i = LBound(ArraySelectPortfolios) To UBound(ArraySelectPortfolios) 'Navigate to all the Portfolios Selected
    'the portfolio codes are stored in the "second column" of the array, say PortfolioCode is the name of the portfolio
    PortfolioCode = ArraySelectPortfolios(i, 2)
        For j = LBound(Application.Transpose(ArrayOfCodePortfolios)) To UBound(Application.Transpose(ArrayOfCodePortfolios)) 'now navigate to where your portfolios are stored
            If ArrayOfCodePortfolios(1, j) = PortfolioCode Then 'if match, create a new array with the whole portfolio
                With ListPortfolios
                    ArrayPortfolio = .Range(.Cells(1, j), .Cells(24, j   2)) 'I don't know the size of your data. I assume that the first column is the same of where the portfoliocode is stored and its size is 24 rows x 3 columns
                End With
                'now, copy it to the Project Portfolio
                ReDim Preserve ArrayProject(1 To 24, 1 To 3   k * 3)
                    For r = 1 To 24 'from the r (row) one to 24th. I don't know how your data is stored
                        For c = 1 To 3 'from the column 1 to the 3rd of each portfolio
                            ArrayProject(r, c   k * 3) = ArrayPortfolio(r, c) 'built the result for each portfolio found
                        Next c
                    Next r
                k = k   1 'one value is found, let's go for the next one if so
            End If
        Next j
Next i

If k <> 0 Then 'if any value is found then
    For i = 1 To UBound(ArraySelectDates) 'let's place the date and print to the excel
        ArrayProject(2, 1) = ArraySelectDates(i, 2) 'paste the date into the array
        With Project
            .Range(.Cells(1, 4   1   (i - 1) * k), .Cells(24, UBound(Application.Transpose(ArrayProject))   3   (i - 1) * k)) = ArrayProject 'print the array
        '1 (i-1)*k is the first column   which date are we copying times portfolio codes found
        End With
    Next i
End If

End Sub
 

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