脚本上的复制和粘贴功能出错

时间:2018-11-29 13:53:41

标签: excel vba excel-vba

我的脚本在dailySht中查找最高值,并将这些值粘贴到单独的工作表recordSht中,该工作通常正常,但有时会出现错误Object variable or With block variable not set。下面是返回错误的代码部分。

Sub DailyBH()
    Dim dailySht As Worksheet 'worksheet storing latest store activity
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day
    Dim lColDaily As Integer ' Last column of data in the store activity sheet
    Dim lCol As Integer ' Last column of data in the record sheet
    Dim maxCustomerRng2 As Range ' Cell containing the highest number of customers
    Dim maxCustomerCnt As Double ' value of highest customer count

    Set dailySht = ThisWorkbook.Sheets("hourly KPI")
    Set recordSht = ThisWorkbook.Sheets("@BH KPI")
    With recordSht
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    With dailySht
        lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
        maxCustomerCnt = Round(Application.Max(.Range(.Cells(58, 1), .Cells(58, lColDaily))), 2)
        Set maxCustomerRng2 = .Range(.Cells(58, 1), .Cells(58, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)

        .Cells(4, maxCustomerRng2.Column).Copy
        recordSht.Cells(4, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(4, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(22, maxCustomerRng2.Column).Copy
        recordSht.Cells(22, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(22, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(40, maxCustomerRng2.Column).Copy
        recordSht.Cells(40, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(40, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(49, maxCustomerRng2.Column).Copy
        recordSht.Cells(49, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(49, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(58, maxCustomerRng2.Column).Copy
        recordSht.Cells(58, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(58, lCol + 1).PasteSpecial xlPasteFormats
    End With

    Set maxCustomerRng = Nothing
    Set dailySht = Nothing
    Set recordSht = Nothing
End Sub

有人可以帮我找出问题所在吗,因为代码在某些单元格上起作用(复制并粘贴正确的值),而不是在其他单元格上起作用。

1 个答案:

答案 0 :(得分:0)

我建议使用Match而不是Find,并直接使用Max的结果,而不要将其转换为Double,以避免浮点错误。

With dailySht
    lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Dim SearchRange As Range
    Set SearchRange = .Range(.Cells(58, 1), .Cells(58, lColDaily))

    Dim MaxCol As Long
    On Error Resume Next 'next line throws error if nothing matched
    MaxCol = Application.WorksheetFunction.Match(Application.WorksheetFunction.Max(SearchRange), SearchRange, 0)
    On Error GoTo 0 're-enable error reporting !!!

    If MaxCol = 0 Then
        'nothing was found
        Exit Sub
    End If

    .Cells(4, MaxCol).Copy
    'your stuff here