Excel VBA-错误1004,对象“ _Worksheet”的方法“范围”失败

时间:2019-09-17 05:44:13

标签: excel vba range formula

我一直在长时间运行此VBA代码,没有错误,当我今天再次运行它时,突然出现错误错误1004,对象'_Worksheet'的方法'Range'失败。

有问题的代码行是:

Call add(qty, pvasWs.range(pvasLocationCol, pvasRow))

整个代码是:

'Pre-req: sku must be on the first column of the worksheet
Sub sortBySKU(ws As Worksheet)
    'Check that the autoFilter mode is off
    If Not ws.AutoFilterMode Then
        ws.range("A1").AutoFilter
    End If

    ws.AutoFilter.Sort.SortFields.Clear
    ws.AutoFilter.Sort.SortFields.add Key:=range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.AutoFilter.Sort.Apply
End Sub

'Function to add a number to a given Range
'Pre-req: range must only represent one cell
Sub add(num As Long, range As range)
    'Check if the box is empty
    If range.Value = "" Then
        range.Value = num
    Else
        range.Value = range.Value + num
    End If
End Sub

'Function that goes through the vas and ok list and merge them to form the
'PVAS table
'Pre-req: Both vas and ok are sorted according to their sku in ascending order
Sub generatePVAS(vasWs As Worksheet, okWs As Worksheet, pvasWs As Worksheet)
    Dim vasRow As Long
    Dim okRow As Long
    Dim pvasRow As Long
    Dim vasSKU As String
    Dim okSKU As String
    Dim pvasSKU As String
    Dim location As String
    Dim qty As Long

    Dim vasSkuCol As String
    Dim vasLocationCol As String
    Dim vasLocCol As String
    Dim vasQtyAvailableCol As String
    Dim okSkuCol As String
    Dim okQtyCol As String
    Dim pvasSkuCol As String
    Dim pvasOkCol As String
    Dim pvasLocationCol As String

    vasSkuCol = findHeader("Sku", vasWs)
    vasLocationCol = findHeader("Location", vasWs)
    vasLocCol = findHeader("Loc", vasWs)
    vasQtyAvailableCol = findHeader("QtyAvailable", vasWs)

    okSkuCol = findHeader("Sku", okWs)
    okQtyCol = findHeader("QtyAvailable", okWs)

    pvasSkuCol = findHeader("Sku", pvasWs)
    pvasOkCol = findHeader("OK", pvasWs)

    'Initialize the values
    pvasSKU = ""
    vasRow = 2
    okRow = 2
    pvasRow = 1
    'Keep on going until one of the value is null
    While vasWs.range(vasSkuCol & vasRow).Value <> "" And okWs.range(okSkuCol & okRow).Value <> ""
        vasSKU = vasWs.range(vasSkuCol & vasRow).Value
        okSKU = okWs.range(okSkuCol & okRow).Value
        'Case where the vas SKU is lesser and we want it
        If StrComp(vasSKU, okSKU) <= 0 Then
            'Check if it is different from the current pvasSKU
            If Not StrComp(vasSKU, pvasSKU) = 0 Then
                pvasRow = pvasRow + 1
                'It is different so we will create a new row and fill the details in
                pvasWs.range(pvasSkuCol & pvasRow).Value = vasSKU
                pvasSKU = vasSKU
            End If

            qty = vasWs.range(vasQtyAvailableCol & vasRow).Value
            location = vasWs.range(vasLocationCol & vasRow).Value
            'Get the correct header to put the number in
            pvasLocationCol = findHeader(location, pvasWs)
            Call add(qty, pvasWs.range(pvasLocationCol & pvasRow))

            'Move on to the next row
            vasRow = vasRow + 1
        Else
            'okSKU is lesser, we will check if it is the same as the previous sku
            If Not StrComp(okSKU, pvasSKU) = 0 Then
                pvasRow = pvasRow + 1
                'It is different so we will create a new row and fill the details in
                pvasWs.range(pvasSkuCol & pvasRow).Value = okSKU
                pvasSKU = okSKU
            End If

            qty = okWs.range(okQtyCol & okRow).Value

            'Transfer the qty from ok to pvas
            Call add(qty, pvasWs.range(pvasOkCol & pvasRow))

            'Move on to the next row
            okRow = okRow + 1
        End If
    Wend

    'Transfer the remaining vas value into the list
    While vasWs.range(vasSkuCol & vasRow).Value <> ""
        vasSKU = vasWs.range(vasSkuCol & vasRow).Value
        'Check if it is different from the current pvasSKU
        If Not StrComp(vasSKU, pvasSKU) = 0 Then
            pvasRow = pvasRow + 1
            'It is different so we will create a new row and fill the details in
            pvasWs.range(pvasSkuCol & pvasRow).Value = vasSKU
            pvasSKU = vasSKU
        End If

        qty = vasWs.range(vasQtyAvailableCol & vasRow).Value
        location = vasWs.range(vasLocationCol & vasRow).Value

        'Get the correct header to put the number in
        pvasLocationCol = findHeader(location, pvasWs)
        Call add(qty, pvasWs.range(pvasLocationCol, pvasRow))

        'Move on to the next row
        vasRow = vasRow + 1
    Wend

    'Transfer the remaining ok value into the list
    While okWs.range(okSkuCol & okRow).Value <> ""
        okSKU = okWs.range(okSkuCol & okRow).Value

        'Check if okSKU is the same as the pvasSKU
        If Not StrComp(okSKU, pvasSKU) = 0 Then
            pvasRow = pvasRow + 1
            'It is different so we will create a new row and fill the details in
            pvasWs.range(pvasSkuCol & pvasRow).Value = okSKU
            pvasSKU = okSKU
        End If

        qty = okWs.range(okQtyCol & okRow).Value

        'Transfer the qty from ok to pvas
        Call add(qty, pvasWs.range(pvasOkCol & pvasRow))

        'Move on to the next row
        okRow = okRow + 1
    Wend

End Sub

'Function to clean the pvas, we want to get rid of all the sku that
'are all done
Sub filterPVAS(pvasWs As Worksheet)
    Dim pvasRow As Long
    Dim sku As String
    Dim inventoryType As String

    Dim skuCol As String
    Dim typeCol As String
    Dim okCol As String

    pvasRow = 2

    skuCol = findHeader("Sku", pvasWs)
    typeCol = findHeader("TYPE", pvasWs)
    okCol = findHeader("OK", pvasWs)

    sku = pvasWs.range(skuCol & pvasRow).Value

    While sku <> ""
        'Check if the OK column is 0, we will put it out
        If pvasWs.range(okCol & pvasRow).Value = "" Then
            pvasWs.range(okCol & pvasRow).Value = 0
        End If

        inventoryType = pvasWs.range(typeCol & pvasRow).Value

        'Check if the type column is empty, if it is we will delete it and move on
        If inventoryType = "" Or StrComp(left(inventoryType, 6), "Type 0") = 0 Then
            'Delete the current row
            pvasWs.range(skuCol & pvasRow).EntireRow.Delete
            'Stay at the same row as the rows would have moved up
            GoTo nextRow
        End If

        'Check if the 3 locations are empty
        If isEmpty(pvasWs, pvasRow) Then
            'Delete the current row
            pvasWs.range(skuCol & pvasRow).EntireRow.Delete
            'Stay at the same row as the rows would have moved up
        Else
            'Move on to the next row
            pvasRow = pvasRow + 1
        End If

nextRow:
        sku = pvasWs.range(skuCol & pvasRow).Value

    Wend
End Sub

'Function that transfers the type of the sku in master sku to pvas
Sub transferType(skuWs As Worksheet, pvasWs As Worksheet)
    Dim pvasRow As Long
    Dim pvasLast As Long
    Dim labelType As String
    Dim sku As String

    Dim pvasSkuCol As String
    Dim pvasTypeCol As String

    pvasLast = Application.CountA(pvasWs.range("A:A"))
    pvasSkuCol = findHeader("Sku", pvasWs)
    pvasTypeCol = findHeader("TYPE", pvasWs)

    For pvasRow = 2 To pvasLast
        sku = pvasWs.range(pvasSkuCol & pvasRow).Value
        labelType = searchForType(skuWs, sku)
        pvasWs.range(pvasTypeCol & pvasRow).Value = labelType
    Next pvasRow

    'Once the type is transfered over, we will filter out the unnecessary details
    Call filterPVAS(pvasWs)
End Sub


'Function that does binary search on the sku master for a given sku and
'returns the label type of the found sku
'If no label is found it returns ""
Function searchForType(skuWs As Worksheet, sku As String)
    Dim left As Long
    Dim right As Long
    Dim middle As Long
    Dim midValue As String

    Dim skuCol As String
    Dim ivasCol As String

    skuCol = findHeader("Sku", skuWs)
    ivasCol = findHeader("IVAS", skuWs)

    left = 2
    right = Application.CountA(skuWs.range(skuCol & ":" & skuCol))

    While left <= right
        middle = (left + right) / 2
        midValue = skuWs.range(skuCol & middle).Value
        'If it is the same as the sku we want, then we found it and we return the
        'type
        If StrComp(sku, midValue) = 0 Then
            searchForType = skuWs.range(ivasCol & middle).Value
            GoTo theEnd
        Else
            'Check if it is less than the mid or more
            If StrComp(sku, midValue) < 0 Then
                right = middle - 1
            Else
                left = middle + 1
            End If
        End If
    Wend
    'The SKU does not exists
    searchForType = ""
theEnd:
End Function

'Function that checks if the row in the pvasWs is empty
'Represents that the sku is done already
Function isEmpty(pvasWs As Worksheet, pvasRow As Long) As Boolean
    Dim typeCol As String
    Dim currCol As String
    Dim colNum As Long
    Dim blank As Boolean

    blank = True
    typeCol = findHeader("TYPE", pvasWs)
    '-64 to push back to the actual letter number +1 to go to the next
    colNum = Asc(typeCol) - 64 + 1
    currCol = Col_Letter(colNum)
    While Not StrComp(pvasWs.range(currCol & "1").Value, "OK") = 0
        'If it is not empty then it is not blank
        If pvasWs.range(currCol & pvasRow).Value <> "" Then
            blank = False
            GoTo theEnd
        End If
        'Go to the next col
        colNum = colNum + 1
        currCol = Col_Letter(colNum)
    Wend
theEnd:
    isEmpty = blank
End Function

有人能帮助我吗?谢谢!

0 个答案:

没有答案