Блог

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

Мой экран решателя выглядит как этот снимок экрана решателя. Идеальным результатом отчета будет эта таблица.Обратите внимание, что в январе только две загрузки (TLS) в качестве выходных данных решателя (ЕСЛИ (E4: N4= True, включить TL, n / a). Итак, новый отчет должен пропустить TLs # 3,4,5 (G4: I4) и заполнить таблицу следующим допустимым выводом (столбец J). Я всегда буду хотеть связать количество единиц (E: N) с названием продукта (D) в новом отчете.

Я супер начинающий пользователь VBA. Вот как далеко я продвинулся в своем VBA для достижения этой цели:

 Sub TL_Report()
Dim c As Range
For Each c In ActiveSheet.Range("e5:e30")
If c.Value <> 0 Then
Worksheets("TL_Report").Range("C" amp; Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 2).Value = Range(c.Offset(0, -1), c).Value
End If
Next c
End Sub
  

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

В соответствии с доступными данными я создал эту подпрограмму:

 Sub SubReport()
    
    'Declarations.
    Dim WksSource As Worksheet
    Dim WksReport As Worksheet
    Dim WksWorksheet01 As Worksheet
    Dim RngMonths As Range
    Dim RngTrucks As Range
    Dim RngProductList As Range
    Dim RngValues As Range
    Dim RngTarget As Range
    Dim RngRange01 As Range
    Dim DblCounter01 As Integer
    Dim DblCounter02 As Integer
    
    'Setting WksSource.
    Set WksSource = Sheets("TL_Solver")
    
    'Referring to WksSource.
    With WksSource
        
        'Setting RngMonths.
        Set RngRange01 = .Range("E2")
        DblCounter01 = Excel.WorksheetFunction.Min(RngRange01.End(xlToRight).Column, _
                                                   .Cells(RngRange01.Row, .Columns.Count).End(xlToLeft).Column _
                                                  )
        Set RngMonths = .Range( _
                               RngRange01, _
                               .Cells(RngRange01.Row, DblCounter01) _
                              )
        
        'Setting RngTrucks.
        Set RngRange01 = .Range("E3")
        DblCounter01 = Excel.WorksheetFunction.Min(RngRange01.End(xlToRight).Column, _
                                                   .Cells(RngRange01.Row, .Columns.Count).End(xlToLeft).Column _
                                                  )
        Set RngTrucks = .Range( _
                               RngRange01, _
                               .Cells(RngRange01.Row, DblCounter01) _
                              )
        
        'Setting RngProductList.
        Set RngRange01 = RngTrucks.Resize(1, 1).Offset(2, -1)
        DblCounter01 = Excel.WorksheetFunction.Min(RngRange01.End(xlDown).Row, _
                                                   .Cells(.Rows.Count, RngRange01.Column).End(xlUp).Row _
                                                  )
        Set RngProductList = .Range( _
                             RngRange01, _
                             .Cells(DblCounter01, RngRange01.Column) _
                            )
        
        'Setting RngValues.
        Set RngRange01 = .Cells(RngProductList.Row, RngTrucks.Column)
        Set RngValues = RngRange01.Resize(RngProductList.Rows.Count, RngTrucks.Columns.Count)
        
    End With
    
    'Creating a new worksheet for the report.
    Set WksReport = ActiveWorkbook.Sheets.Add(After:=WksSource)
    
    'Counting other existing reports if any.
    DblCounter01 = 0
    For Each WksWorksheet01 In WksReport.Parent.Worksheets()
        If Left(WksWorksheet01.Name, 7) = "Report " Then
            DblCounter01 = DblCounter01   1
        End If
    Next
    
    'Renaming the current report.
    DblCounter02 = DblCounter01
    On Error Resume Next
    Do Until WksReport.Name = "Report " amp; DblCounter01
        DblCounter01 = DblCounter01   1
        WksReport.Name = "Report " amp; DblCounter01
        If DblCounter01 - DblCounter02 > 1000 Then GoTo CP_FAILED_RENAMING
    Loop
CP_FAILED_RENAMING:
    On Error GoTo 0
    
    'Setting RngTarget.
    Set RngTarget = WksReport.Range("A1")
    
    'Covering each column in RngValues.
    For DblCounter01 = 1 To RngValues.Columns.Count
        
        'Checking if there is any value to report.
        If Excel.WorksheetFunction.Sum(RngValues.Columns(DblCounter01).Cells) <> 0 Then
        
            'Inserting the data for the first row of the report's chapter.
            With RngTarget
                .Offset(0, 1).Value = "Truck #"
                .Offset(0, 2).Value = Split(RngTrucks.Cells(1, DblCounter01), "#")(1)
                .Offset(0, 3).Value = "Delivery"
                If WksSource.Cells(RngMonths.Row, RngTrucks.Columns(DblCounter01).Column).Value = "" Then
                    .Offset(0, 4).Value = WksSource.Cells(RngMonths.Row, RngTrucks.Columns(DblCounter01).Column).End(xlToLeft).Value
                Else
                    .Offset(0, 4).Value = WksSource.Cells(RngMonths.Row, RngTrucks.Columns(DblCounter01).Column).Value
                End If
                .Offset(1, 1).Value = "Product"
                .Offset(1, 2).Value = "Quantity"
            End With
            
            'Offsetting RngTarget by 2 rows in order to enter the data.
            Set RngTarget = RngTarget.Offset(2, 0)
            
            'Covering each value in the given column of RngValues.
            DblCounter02 = 1
            For Each RngRange01 In RngValues.Columns(DblCounter01).Cells
                'Checking if the value is not 0.
                If RngRange01.Value <> 0 Then
                    'Inserting the data.
                    With RngTarget
                        .Value = DblCounter02
                        .Offset(0, 1).Value = WksSource.Cells(RngRange01.Row, RngProductList.Column).Value
                        .Offset(0, 2).Value = RngRange01.Value
                    End With
                    DblCounter02 = DblCounter02   1
                    'Offsetting RngTarget to the next row of the report.
                    Set RngTarget = RngTarget.Offset(1, 0)
                End If
            Next
            
            'Offsetting RngTarget by 1 row for the next chapter.
            Set RngTarget = RngTarget.Offset(1, 0)
            
        End If
    Next
    
    'Autofitting the second column of the report.
    RngTarget.Offset(0, 1).EntireColumn.AutoFit
    
End Sub
  

Он динамически определяет размер обрабатываемых данных (начиная с заданных ячеек), создает новый лист с именем «Отчет n» (на основе n ранее существовавших листов, уже названных «Отчет n«) и вставляет данные по запросу.