我一直在长时间运行此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
有人能帮助我吗?谢谢!