两个算法的校正计算空行

Question

是否可以纠正这两种算法？当我按标准进行过滤时，我计算了两列，“Pareto_Analysis”和“累积”，我的问题是：两个算法不计算过滤的数据，而是计算所有行。

以下是此屏幕打印机上的过滤示例

custom management command

“Pareto_Analysis”的代码算法：

Sub calculDefect()

Dim ws As Worksheet

Set ws = Sheet7
With ws
    Const SourceColumn As String = "G"
    Const DestColumn As String = "K"
    Const TotalCell As String = "H4"  'total defect of all defect
    Const StartRow As Integer = 11
    Const EndRow As Integer = 100

    For i = StartRow To EndRow
       ws.Range(DestColumn & i).Formula = "=(" & SourceColumn & i & "/" & TotalCell & ")*100"
    Next i
End With

End Sub

“cumule”的代码算法：

Sub calculatCumule()

Dim ws As Worksheet

Set ws = Sheet7
With ws
    LastRow = ActiveSheet.Cells(Rows.Count, 11).End(xlUp).Row
    Range("L11") = Range("K11").Value
    Range("L12").FormulaR1C1 = "=R[-1]C+RC[-1]"
    Range("L12").AutoFill Destination:=Range("L12:L" & LastRow & "")
End With

End Sub

为了进一步澄清这个问题，这里还有一些屏幕转储：

在这里，我选择了我想要的标准：

显示我选择的数据：

根据列“Quantity_prod”计算“pareto”列，根据“pareto”列计算“cumule”列： 如果你在最后一张图片中注意到其余的列有0和100重复，通常应该只计算4行。

Answer 1

尝试下面的2个修改后的“算法”代码。

首先，您需要运行Sub calculDefect，然后运行Sub calculatCumule。

Sub calculDefect()

Dim ws As Worksheet
Const SourceColumn As String = "G"
Const DestColumn As String = "K"
Const TotalCell As String = "H4"  'total defect of all defects
Const StartRow As Long = 11
Dim EndRow As Long, i As Long

Set ws = Sheet7
With ws
    EndRow = .Range("G" & StartRow).End(xlDown).Row '<-- get last row with data in Column G

    For i = StartRow To EndRow
       .Range(DestColumn & i).Formula = "=(" & SourceColumn & i & "/" & TotalCell & ")*100"
    Next i
End With

End Sub

'====================================================================

Sub calculatCumule()

Dim ws As Worksheet
Dim LastRow As Long

Set ws = Sheet7
With ws
    LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row '<-- get last row with data in Column K
    .Range("L11") = .Range("K11").Value
    .Range("L12").FormulaR1C1 = "=R[-1]C+RC[-1]"
    .Range("L12:L" & LastRow).FillDown
End With

End Sub

我已经运行此代码的结果的屏幕截图：

编辑1 ：过滤数据时相同的2个“算法”：

Sub calculDefect()

Dim ws As Worksheet
Const SourceColumn As String = "G"
Const DestColumn As String = "K"
Const TotalCell As String = "H4"  'total defect of all defects
Const StartRow As Long = 11
Dim EndRow As Long, i As Long
Dim VisRng  As Range, C As Range

Set ws = Sheet7
With ws
    EndRow = .Range("G" & StartRow).End(xlDown).Row '<-- get last row with data in Column G

    ' set visible range to only filtered cells in Column G
    Set VisRng = .Range(Range(SourceColumn & StartRow), Range(SourceColumn & EndRow)).SpecialCells(xlCellTypeVisible)

    .Range(TotalCell).Formula = WorksheetFunction.Sum(VisRng) '<-- re-calculate Total defects according to visible range

    For Each C In VisRng
        .Range(DestColumn & C.Row).Formula = "=(" & SourceColumn & C.Row & "/" & TotalCell & ")*100"
    Next C
End With

End Sub

'=================================================================

Sub calculatCumule()

Dim ws As Worksheet
Dim VisRng As Range, C As Range
Dim StartRow As Long
Dim LastRow As Long

Set ws = Sheet7
With ws
    LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row '<-- get last row with data in Column K

    StartRow = 11 '<-- init value
     ' set visible range to only filtered cells in Column G
    Set VisRng = .Range(Range("K" & StartRow), Range("K" & LastRow)).SpecialCells(xlCellTypeVisible)
    StartRow = VisRng.Item(1).Row '<-- update first row in visible range

    For Each C In VisRng
        If C.Row = StartRow Then
            .Range("L" & C.Row) = .Range("K" & C.Row).Value
        Else
            .Range("L" & C.Row).Formula = "=SUBTOTAL(9,K" & StartRow & ":K" & C.Row & ")"
        End If
    Next C

End With

End Sub

结果的屏幕截图我在将“Type_defect”过滤到CPE02时运行此代码：