excel - 从一张表中获取非零值和相邻数据并在另一张表中创建新表 - VBA循环
问题描述
我正在尝试从求解器模型中获取输出并将其压缩为另一张表中的摘要报告。每次我在新数据上运行求解器屏幕时,它都会丢失。
我的求解器屏幕看起来像这个 Solver screenshot。理想的报告输出将是此表。请注意,1 月份只有两卡车 (TL) 作为 Solver 输出 (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
我可以弄清楚如何遍历求解器中的每一列,但我无法弄清楚如何在没有空白条目的情况下重新格式化新报告。关于如何写这个有什么建议吗?谢谢你。
解决方案
根据可用的数据,我创建了这个子程序:
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 个预先存在的工作表)并根据要求插入数据.
推荐阅读
- python - 如何将曲面连接在一起以在 Python 中形成 3D 图像?
- javascript - 带有增量数字的动态 id="errorMessage1"?
- python - 如何根据标签的属性解析 3.5GB 的 XML 文件?
- python - 从推文中获取回复(Python)
- animation - 动画侧边导航菜单:如何避免跳转布局?
- flutter - 有没有办法使用 flutter_local_notifications 跳过定期通知?
- java - 从 Java 程序 (AWS CDK) 检索现有 VPC
- python - pd.read_excel 中的参数无效
- sql - 如何将 varchar 列表传递给 Oracle 中的过程?
- vuetify.js - Vuetify Snackbar:点击不会调用我的函数