首页 > 解决方案 > 函数删除不应该删除的行

问题描述

当我执行此操作时,它将删除“精炼”行,当我将此功能注释掉时,“精炼”行不会被删除。我继承了这段代码,并且我将每个部分都添加到了“精炼”中,因为我试图添加除“gas”和“oil”之外的额外产品,但我真的不知道 VBA 或编程。我一直在尝试它,除了本节之外,它大部分都在工作。

我的问题是我添加到代码中的内容有什么问题?我编辑或添加了每行包含“refined”一词的行。它适用于石油和天然气,但始终会删除精炼列。当它执行石油、天然气和精炼数据填充工作表时,它会立即删除它拉入的所有精炼列。

在没有某种代码模板的情况下,我没有能力将其重写为不同的直到循环。

This function checks the Current Prices tab for any columns that are duplicates of the day before or weekends and deletes the column
Function PricesCleanup() As Boolean

    Dim r, c As Integer
    Dim removeCount As Integer
    Dim removeColumn As Boolean
    Dim isGas, isOil, isRefined As Boolean

    c = FIRSTDATA_COL
    removeCount = 0

    Do Until IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c)) 'check every col of prices
        'Start at the row of the first date and reset remove flag
        r = FIRSTDATE_ROW
        removeColumn = True

        'Check each column, at least until there is a discrepancy between prices so we know it's not a holiday
        Do Until ((r > 12 And IsEmpty(ws_currentprices.Cells(r, c))) Or r > 60 Or Not removeColumn)
            'If the prices don't match, we know it's not a holiday
            If (ws_currentprices.Cells(r, c) <> ws_currentprices.Cells(r, c + 1)) Then
                'If the first row is empty or matches second row, it's likely due to near EoM index shifting and requires special handling
                If r = FIRSTDATE_ROW Then
                    If IsEmpty(ws_currentprices.Cells(r, c)) Then
                        'Oil index swap
                        removeColumn = False
                    End If
                    If (ws_currentprices.Cells(r, c) = ws_currentprices.Cells(r + 1, c) And ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Gas") Then
                        'Gas index swap so clear cell and allow to continue but only if within the last few workdays of the month
                        If (DateDiff("d", WorksheetFunction.WorkDay(ws_currentprices.Cells(r, BUCKET_COL), -1), ws_currentprices.Cells(ASOFDATE_ROW, c)) > -3) Then
                            ws_currentprices.Cells(r, c).ClearContents
                        End If
                    End If
                Else
                    'Not index related and no match, so don't remove column
                    removeColumn = False
                End If
            End If
            r = r + 1
        Loop

        'Check for weekend dates or dates from prior month
        If Weekday(ws_currentprices.Cells(ASOFDATE_ROW, c)) = 1 Or Weekday(ws_currentprices.Cells(ASOFDATE_ROW, c)) = 7 Or Month(ws_currentprices.Cells(ASOFDATE_ROW, c)) <> Month(ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
            removeColumn = True
        End If

        'Remove column if flagged
        If removeColumn Then
            removeCount = removeCount + 1
            ws_currentprices.Columns(c).EntireColumn.Delete
            c = c - 1
        End If

        'Copy up spot price
        If Not IsEmpty(ws_currentprices.Cells(FIRSTDATE_ROW, c)) Then
            ws_currentprices.Cells(SPOT_ROW, c) = ws_currentprices.Cells(FIRSTDATE_ROW, c)
        ElseIf Not IsEmpty(ws_currentprices.Cells(FIRSTDATE_ROW + 1, c)) Then
            ws_currentprices.Cells(SPOT_ROW, c) = ws_currentprices.Cells(FIRSTDATE_ROW + 1, c)
        Else
            ws_currentprices.Cells(SPOT_ROW, c) = ""
        End If


        c = c + 1
    Loop

    'Check if any columns are left and return bool value
    isGas = False
    isOil = False
    isRefined = False
    c = FIRSTDATA_COL
    Do Until IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c))
        If (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Gas") Then
            isGas = True
        ElseIf (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Oil") Then
            isOil = True
        ElseIf (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Refined") Then
            isRefined = True
        End If

        c = c + 1
    Loop

    If (isGas And isOil And isRefined) Then
        PricesCleanup = True
    Else
        PricesCleanup = False
    End If

End Function

标签: excelvba

解决方案


推荐阅读