從一張工作表中獲取非零值和相鄰數據，並在另一張工作表中創建新表 - VBA 循環

Question

我正在嘗試從求解器模型中獲取輸出並將其壓縮為另一個工作表中的摘要報告。 每次我在新數據上運行求解器屏幕時，它都會丟失。

我的求解器屏幕看起來像這個Solver screenshot 。 理想的報告輸出將是此表。 請注意，一月只有兩卡車 (TL) 作為求解器輸出 (IF(E4:N4=True,Include TL,n/a)。因此，新報告應跳過 TL #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" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 2).Value = Range(c.Offset(0, -1), c).Value
End If
Next c
End Sub

我可以弄清楚如何遍歷求解器中的每一列，但我無法弄清楚如何在沒有空白條目的情況下重新格式化新報告。 關於如何寫這個的任何建議？ 謝謝你。

Answer 1

根據可用的數據，我創建了這個子程序：

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 " & DblCounter01
        DblCounter01 = DblCounter01 + 1
        WksReport.Name = "Report " & 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

它動態地確定要處理的數據的大小（從給定的單元格開始），它創建一個重命名為“Report n ”的新工作表（基於已經命名為“Report n ”的n 個預先存在的工作表）並根據要求插入數據.