如何根据最小截止值动态删除数据

时间:2015-01-01 14:56:51

标签: excel vba excel-vba

我是路易斯安那州一家小型石油公司的地质学家。我构成了我们的技术部门,不幸的是我的编码经验非常有限。我过去使用过非常基本的vba编码,但是在日常工作中我没有那么多代码,所以我已经忘记了大部分内容。我最近发现了这个网站,它已成为我的一个很好的资源。我已经能够从以前的问题的回答中收集到一些代码,但我再一次陷入困境。

我正在开发一个宏,它可以从路易斯安那州的DNR下载完整的生产信息,然后根据下载的数据计算出某些值。到目前为止,我有代码检索数据,对其进行排序,并计算我需要的值。

现在我需要能够修剪这些数据。每口井生产石油的时间都不同。目前我的宏将公式扩展到单元格50(数据永远不会达到这一点。我选择它只是为了确保公式适用于所有单元格)。大多数计算值为0我想创建一个宏,删除包含1或更大数字的最后一个单元格之后的所有值。

包含我要删除的数据的单元格位于Cell L

如果我还有其他需要或者我没有解释我的问题,请告诉我 好。

这是我为计算Cell L

中的数据而生成的代码
Sub Oil_production_by_year()
'
' Oil_production_by_year Macro
'

'
Dim ws As Worksheet

    For Each ws In Sheets
        ws.Activate

    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS(RC[-8]:R[2998]C[-8],RC[-11]:R[2998]C[-11],"">=""&RC[8],RC[-11]:R[2998]C[-11],""<=""&RC[9])"
    Range("L2").Select
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.SmallScroll Down:=-6
    Selection.AutoFill Destination:=Range("L2:L51"), Type:=xlFillDefault
    Range("L2:L51").Select
Next ws

End Sub

2 个答案:

答案 0 :(得分:1)

Josiah你好,祝你新年快乐。

此代码假定:

dataCol是数据的参考列,用于确定自动填充SUMIFS公式的行数。目前它被设置为col no.5(col E),因此更改它以适合您的数据。

trimVal是一个变量,它保存将删除单元格值的值。目前设为1。

删除公式单元格时,同一列中“下方”的任何数据都会向上移动。

Option Explicit
Sub Oil_production_by_year() ' ' Oil_production_by_year Macro '
Dim ws As Worksheet
Dim stRow As Long, formulaCol As Long, c As Long
Dim dataCol As Long, dataEndRow As Long, trimVal As Long

stRow = 2
formulaCol = 12
trimVal = 1
'an assumption of colE for the data column
'change this to suit
'means that the formula will only fill the rows reqd
dataCol = 5

For Each ws In Sheets
    With ws
        dataEndRow = .Cells(Rows.Count, dataCol).End(xlUp).Row
        With ws.Cells(stRow, formulaCol)
            .FormulaR1C1 = _
                "=SUMIFS(RC[-8]:R[2998]C[-8],RC[-11]:R[2998]C[-11],"">=""&RC[8],RC[-11]:R[2998]C[-11],""<=""&RC[9])"
            .AutoFill Destination:=ws.Range(ws.Cells(stRow, formulaCol), ws.Cells(dataEndRow, formulaCol)), _
                    Type:=xlFillDefault
        End With

        For c = dataEndRow To stRow Step -1
            If .Cells(c, formulaCol).Value < trimVal Then
                .Cells(c, formulaCol).Delete xlShiftUp
            Else
                Exit For
            End If
        Next c
    End With
Next ws

End Sub 

答案 1 :(得分:0)

仍然不知道您要删除哪种数据...我建议更改代码,如下所示:

Option Explicit

Sub Oil_production_by_year()
Dim wsh As Worksheet, iLastCell As Integer, r As Integer

For Each wsh In ThisWorkbook.Worksheets
    iLastCell = GetLastCell(wsh)
    wsh.Range("L2").FormulaR1C1 = "=SUMIFS(RC[-8]:R[2998]C[-8],RC[-11]:R[2998]C[-11],"">=""&RC[8],RC[-11]:R[2998]C[-11],""<=""&RC[9])"
    wsh.Range("L2").AutoFill Destination:=wsh.Range("L2:L" & iLastCell), Type:=xlFillDefault
    r = iLastCell
    Do While r > 2
        If wsh.Range("L" & r).Value = 0 Then
            'delete entire row
            wsh.Range("L" & r).EntireRow.Delete xlShiftUp
        End If
        If wsh.Range("L" & r).Value > 0 Then Exit Do End If
        r = r - 1
    Loop
Next

End Sub

Function GetLastCell(wsh As Worksheet, Optional sCol As String = "A")
    GetLastCell = wsh.Range(sCol & wsh.Rows.Count).End(xlUp).Row
End Function

根据需要更改代码;)